]>
Commit | Line | Data |
---|---|---|
9aaba0d6 | 1 | C*********************************************************************** |
2 | C | |
3 | C | |
4 | C | |
5 | C PHOJET version 1.12 | |
6 | C ------------------- | |
7 | C | |
8 | C | |
9 | C ($Revision: 1.12.1.35 $, $Date: 2000/06/25 21:59:19 $) | |
10 | C | |
11 | C | |
12 | C Authors: Ralph Engel | |
13 | C (ralph.engel@fzk.de) | |
14 | C | |
15 | C Johannes Ranft | |
16 | C (johannes.ranft@cern.ch) | |
17 | C | |
18 | C Stefan Roesler | |
19 | C (Stefan.Roesler@cern.ch) | |
20 | C | |
21 | C | |
22 | C For the latest version and documentation check | |
23 | C http://www-ik.fzk.de/~engel/phojet.html | |
24 | C | |
25 | C | |
26 | C Bug reports, questions, complaints are welcome | |
27 | C (please send a mail to ralph.engel@fzk.de). | |
28 | C | |
29 | C | |
30 | C Note that the code is available with several interfaces to | |
31 | C Lund fragmentation programs (JETSET7.x, 1.x and a double | |
32 | C precision JETSET version). This file is the code with | |
33 | C | |
34 | C interface to PYTHIA 6.1 (or higher) | |
35 | C for usage in DPMJET 3.x (Lund common block dimensions increased) | |
36 | C | |
37 | C*********************************************************************** | |
38 | C | |
39 | C | |
40 | C List of subroutines and functions | |
41 | C --------------------------------- | |
42 | C | |
43 | C | |
44 | C main event simulation routines | |
45 | C | |
46 | C PHO_EVENT | |
47 | C PHO_PARTON | |
48 | C PHO_POSPOM | |
49 | C | |
50 | C PHO_STDPAR | |
51 | C PHO_POMSCA | |
52 | C | |
53 | C | |
54 | C user steering interface | |
55 | C | |
56 | C PHO_SETMDL | |
57 | C PHO_PRESEL | |
58 | C | |
59 | C | |
60 | C experimental setup / photon flux calculation | |
61 | C | |
62 | C PHO_FIXLAB | |
63 | C PHO_FIXCOL | |
64 | C PHO_GPHERA | |
65 | C PHO_GGEPEM | |
66 | C PHO_WGEPEM | |
67 | C PHO_GGBLSR | |
68 | C PHO_GGBEAM | |
69 | C PHO_GGHIOF | |
70 | C PHO_GGHIOG | |
71 | C PHO_GGFLCL | |
72 | C PHO_GGFLCR | |
73 | C PHO_GGFAUX | |
74 | C PHO_GGFNUC | |
75 | C PHO_GHHIOF | |
76 | C PHO_GHHIAS | |
77 | C | |
78 | C | |
79 | C initialization | |
80 | C | |
81 | C PHO_INIT | |
82 | C PHO_DATINI | |
83 | C PHO_PARDAT | |
84 | C PHO_MCINI | |
85 | C | |
86 | C PHO_EVEINI | |
87 | C | |
88 | C PHO_HARINI | |
89 | C PHO_FRAINI | |
90 | C | |
91 | C PHO_FITPAR | |
92 | C | |
93 | C | |
94 | C cross section calculation | |
95 | C | |
96 | C PHO_CSINT | |
97 | C | |
98 | C PHO_XSECT | |
99 | C PHO_BORNCS | |
100 | C PHO_HARXTO | |
101 | C | |
102 | C PHO_DSIGDT | |
103 | C | |
104 | C PHO_TRIREG | |
105 | C PHO_LOOREG | |
106 | C PHO_TRXPOM | |
107 | C | |
108 | C PHO_EIKON | |
109 | C PHO_CHAN2A | |
110 | C | |
111 | C PHO_SCALES | |
112 | C | |
113 | C | |
114 | C multiple interaction structure | |
115 | C | |
116 | C PHO_IMPAMP | |
117 | C PHO_PRBDIS | |
118 | C PHO_SAMPRO | |
119 | C PHO_SAMPRB | |
120 | C | |
121 | C | |
122 | C hadron / photon remnant treatment, soft x selection | |
123 | C | |
124 | C PHO_HARREM | |
125 | C PHO_PARREM | |
126 | C | |
127 | C PHO_HADSP2 | |
128 | C PHO_HADSP3 | |
129 | C PHO_SOFTXX | |
130 | C PHO_SELSXR | |
131 | C PHO_SELSX2 | |
132 | C PHO_SELSXS | |
133 | C PHO_SELSXI | |
134 | C | |
135 | C PHO_VALFLA | |
136 | C PHO_REGFLA | |
137 | C PHO_SEAFLA | |
138 | C PHO_FLAUX | |
139 | C PHO_BETAF | |
140 | C IPHO_DIQU | |
141 | C | |
142 | C | |
143 | C primordial kt and soft parton pt | |
144 | C | |
145 | C PHO_PRIMKT | |
146 | C PHO_PARTPT | |
147 | C PHO_SOFTPT | |
148 | C PHO_SELPT | |
149 | C | |
150 | C PHO_CONN0 | |
151 | C PHO_CONN1 | |
152 | C | |
153 | C | |
154 | C simulation of hard scattering, initial state radiation | |
155 | C | |
156 | C PHO_HARCOL | |
157 | C PHO_SELCOL | |
158 | C PHO_HARCOR | |
159 | C | |
160 | C PHO_HARDIR | |
161 | C PHO_HARX12 | |
162 | C PHO_HARDX1 | |
163 | C PHO_HARKIN | |
164 | C PHO_HARWGH | |
165 | C PHO_HARSCA | |
166 | C PHO_HARFAC | |
167 | C PHO_HARWGX | |
168 | C PHO_HARWGI | |
169 | C PHO_HARINT | |
170 | C PHO_HARMCI | |
171 | C | |
172 | C PHO_HARXR3 | |
173 | C PHO_HARXR2 | |
174 | C PHO_HARXD2 | |
175 | C PHO_HARXPT | |
176 | C PHO_HARISR | |
177 | C PHO_HARZSP | |
178 | C | |
179 | C PHO_PTCUT | |
180 | C PHO_ALPHAE | |
181 | C PHO_ALPHAS | |
182 | C | |
183 | C | |
184 | C diffraction dissociation | |
185 | C | |
186 | C PHO_DIFDIS | |
187 | C PHO_DIFPRO | |
188 | C PHO_DIFPAR | |
189 | C PHO_QELAST | |
190 | C PHO_CDIFF | |
191 | C PHO_DFWRAP | |
192 | C | |
193 | C PHO_SAMASS | |
194 | C PHO_DSIGDM | |
195 | C PHO_DFMASS | |
196 | C | |
197 | C PHO_SDECAY | |
198 | C PHO_SDECY2 | |
199 | C PHO_SDECY3 | |
200 | C | |
201 | C PHO_DIFSLP | |
202 | C PHO_DIFKIN | |
203 | C PHO_VECRES | |
204 | C PHO_DIFRES | |
205 | C | |
206 | C PHO_REGPAR | |
207 | C | |
208 | C PHO_PECMS | |
209 | C PHO_SETPAR | |
210 | C | |
211 | C | |
212 | C fragmentation, treatment of low-mass strings | |
213 | C | |
214 | C PHO_STRING | |
215 | C PHO_STRFRA | |
216 | C | |
217 | C PHO_ID2STR | |
218 | C PHO_MCHECK | |
219 | C PHO_POMCOR | |
220 | C PHO_MASCOR | |
221 | C PHO_PARCOR | |
222 | C | |
223 | C PHO_GLU2QU | |
224 | C PHO_GLUSPL | |
225 | C | |
226 | C PHO_DQMASS | |
227 | C PHO_BAMASS | |
228 | C PHO_MEMASS | |
229 | C | |
230 | C | |
231 | C particle code tables, particle numbering conversion | |
232 | C | |
233 | C PHO_PNAME | |
234 | C PHO_PMASS | |
235 | C IPHO_CHR3 | |
236 | C IPHO_BAR3 | |
237 | C | |
238 | C IPHO_ANTI | |
239 | C | |
240 | C IPHO_PDG2ID | |
241 | C IPHO_ID2PDG | |
242 | C IPHO_LU2PDG | |
243 | C IPHO_PDG2LU | |
244 | C | |
245 | C IPHO_CNV1 | |
246 | C PHO_HACODE | |
247 | C | |
248 | C | |
249 | C | |
250 | C Lorentz transformations, rotations and mass adjustment | |
251 | C | |
252 | C PHO_ALTRA | |
253 | C PHO_LTRANS | |
254 | C PHO_TRANS | |
255 | C PHO_TRANI | |
256 | C | |
257 | C PHO_MKSLTR | |
258 | C PHO_GETLTR | |
259 | C | |
260 | C PHO_LTRHEP | |
261 | C | |
262 | C PHO_MSHELL | |
263 | C PHO_MASSAD | |
264 | C | |
265 | C | |
266 | C program debugging and internal cross-checks | |
267 | C | |
268 | C PHO_PREVNT | |
269 | C PHO_PRSTRG | |
270 | C PHO_CHECK | |
271 | C | |
272 | C PHO_TRACE | |
273 | C | |
274 | C PHO_REJSTA | |
275 | C | |
276 | C PHO_ABORT | |
277 | C | |
278 | C | |
279 | C cross section fitting | |
280 | C | |
281 | C PHO_FITMAI | |
282 | C PHO_FITINP | |
283 | C PHO_FITDAT | |
284 | C PHO_FITOUT | |
285 | C PHO_FITAMP | |
286 | C PHO_FITTST | |
287 | C PHO_FITMSQ | |
288 | C PHO_FITVD1 | |
289 | C PHO_FITCN1 | |
290 | C PHO_FITINI | |
291 | C | |
292 | C | |
293 | C cross section parametrizations | |
294 | C | |
295 | C PHO_HADCSL | |
296 | C PHO_ALLM97 | |
297 | C PHO_CSDIFF | |
298 | C | |
299 | C | |
300 | C random numbers | |
301 | C | |
302 | C DPMJET random number generator DT_RNDM used | |
303 | C | |
304 | C PHO_SFECFE | |
305 | C PHO_RNDBET | |
306 | C PHO_RNDGAM | |
307 | C | |
308 | C | |
309 | C auxiliary routines / numerical methods | |
310 | C | |
311 | C PHO_GAUSET | |
312 | C PHO_GAUDAT | |
313 | C | |
314 | C pho_samp1d | |
315 | C | |
316 | C PHO_DZEROX | |
317 | C PHO_EXPINT | |
318 | C PHO_BESSJ0 | |
319 | C PHO_BESSI0 | |
320 | C pho_ExpBessI0 | |
321 | C PHO_BESSI1 | |
322 | C PHO_BESSK0 | |
323 | C PHO_BESSK1 | |
324 | C | |
325 | C PHO_XLAM | |
326 | C | |
327 | C PHO_SWAPD | |
328 | C PHO_SWAPI | |
329 | C | |
330 | C | |
331 | C parton density parametrization management / interface | |
332 | C | |
333 | C PHO_PDF | |
334 | C | |
335 | C PHO_SETPDF | |
336 | C PHO_GETPDF | |
337 | C PHO_ACTPDF | |
338 | C | |
339 | C PHO_QPMPDF | |
340 | C | |
341 | C PHO_PDFTST | |
342 | C | |
343 | C | |
344 | C parton density parametrizations from other authors | |
345 | C | |
346 | C PHO_DOR98LO | |
347 | C PHO_DOR98SC | |
348 | C PHO_DOR94LO | |
349 | C PHO_DOR94HO | |
350 | C PHO_DOR94DI | |
351 | C PHO_DOR92LO | |
352 | C PHO_DOR92HO | |
353 | C PHO_DORPLO | |
354 | C PHO_DORPHO | |
355 | C PHO_DORGLO | |
356 | C PHO_DORGHO | |
357 | C PHO_DORGH0 | |
358 | C PHO_DOR94FV | |
359 | C PHO_DOR94FW | |
360 | C PHO_DOR94FS | |
361 | C PHO_DOR92FV | |
362 | C PHO_DOR92FW | |
363 | C PHO_DOR92FS | |
364 | C PHO_DORFVP | |
365 | C PHO_DORFGP | |
366 | C PHO_DORFQP | |
367 | C PHO_DORGF | |
368 | C PHO_DORGFS | |
369 | C PHO_grsf1 | |
370 | C PHO_grsf2 | |
371 | C | |
372 | C PHO_CKMTPA | |
373 | C PHO_CKMTPD | |
374 | C PHO_CKMTPO | |
375 | C PHO_CKMTFV | |
376 | C | |
377 | C PHO_DBFINT | |
378 | C | |
379 | C PHO_SASGAM | |
380 | C PHO_SASVMD | |
381 | C PHO_SASANO | |
382 | C PHO_SASBEH | |
383 | C PHO_SASDIR | |
384 | C | |
385 | C PHO_PHGAL | |
386 | C PHVAL | |
387 | C | |
388 | C | |
389 | C*********************************************************************** | |
390 | ||
391 | *$ CREATE PHO_INIT.FOR | |
392 | *COPY PHO_INIT | |
393 | CDECK ID>, PHO_INIT | |
394 | SUBROUTINE PHO_INIT(LINP,LOUT,IREJ) | |
395 | C*********************************************************************** | |
396 | C | |
397 | C main subroutine to configure and manage PHOJET calculations | |
398 | C | |
399 | C input: LINP input unit to read from | |
400 | C -1 to skip reading of input file | |
401 | C LOUT output unit to write to | |
402 | C | |
403 | C output: IREJ 0 success | |
404 | C 1 failure | |
405 | C | |
406 | C*********************************************************************** | |
407 | IMPLICIT DOUBLE PRECISION (A-H,O-Z) | |
408 | SAVE | |
409 | ||
410 | C input/output channels | |
411 | INTEGER LI,LO | |
412 | COMMON /POINOU/ LI,LO | |
413 | C event debugging information | |
414 | INTEGER NMAXD | |
415 | PARAMETER (NMAXD=100) | |
416 | INTEGER IDEB,KSPOM,KHPOM,KSREG,KHDIR,KACCEP,KSTRG,KHTRG,KSLOO, | |
417 | & KHLOO,KSDPO,KHDPO,KEVENT,KSOFT,KHARD | |
418 | COMMON /PODEBG/ IDEB(NMAXD),KSPOM,KHPOM,KSREG,KHDIR,KACCEP,KSTRG, | |
419 | & KHTRG,KSLOO,KHLOO,KSDPO,KHDPO,KEVENT,KSOFT,KHARD | |
420 | C model switches and parameters | |
421 | CHARACTER*8 MDLNA | |
422 | INTEGER ISWMDL,IPAMDL | |
423 | DOUBLE PRECISION PARMDL | |
424 | COMMON /POMDLS/ MDLNA(50),ISWMDL(50),PARMDL(400),IPAMDL(400) | |
425 | C general process information | |
426 | INTEGER IPROCE,IDNODF,IDIFR1,IDIFR2,IDDPOM,IPRON | |
427 | COMMON /POPRCS/ IPROCE,IDNODF,IDIFR1,IDIFR2,IDDPOM,IPRON(15,4) | |
428 | ||
429 | C global event kinematics and particle IDs | |
430 | INTEGER IFPAP,IFPAB | |
431 | DOUBLE PRECISION ECM,PCM,PMASS,PVIRT | |
432 | COMMON /POGCMS/ ECM,PCM,PMASS(2),PVIRT(2),IFPAP(2),IFPAB(2) | |
433 | C nucleon-nucleus / nucleus-nucleus interface to DPMJET | |
434 | INTEGER IDEQP,IDEQB,IHFLD,IHFLS | |
435 | DOUBLE PRECISION ECMN,PCMN,SECM,SPCM,XPSUB,XTSUB | |
436 | COMMON /POHDFL/ ECMN,PCMN,SECM,SPCM,XPSUB,XTSUB, | |
437 | & IDEQP(2),IDEQB(2),IHFLD(2,2),IHFLS(2) | |
438 | C integration precision for hard cross sections (obsolete) | |
439 | INTEGER NGAUP1,NGAUP2,NGAUET,NGAUIN,NGAUSO | |
440 | COMMON /POGAUP/ NGAUP1,NGAUP2,NGAUET,NGAUIN,NGAUSO | |
441 | C some hadron information, will be deleted in future versions | |
442 | INTEGER NFS | |
443 | DOUBLE PRECISION QMASS,BET,PCOUDI,PNORM,VALPRG | |
444 | COMMON /POHDRN/ QMASS(6),BET,PCOUDI,PNORM,VALPRG(2),NFS | |
445 | C obsolete cut-off information | |
446 | DOUBLE PRECISION PTCUT,PTANO,FPS,FPH,PSOMIN,XSOMIN | |
447 | COMMON /POCUT1/ PTCUT(4),PTANO(4),FPS(4),FPH(4),PSOMIN,XSOMIN | |
448 | C photon flux kinematics and cuts | |
449 | DOUBLE PRECISION ECMIN,ECMAX,EEMIN1,EEMIN2, | |
450 | & YMIN1,YMAX1,YMIN2,YMAX2, | |
451 | & Q2MIN1,Q2MAX1,Q2MIN2,Q2MAX2, | |
452 | & THMIN1,THMAX1,THMIN2,THMAX2 | |
453 | INTEGER ITAG1,ITAG2 | |
454 | COMMON /POFCUT/ ECMIN,ECMAX,EEMIN1,EEMIN2, | |
455 | & YMIN1,YMAX1,YMIN2,YMAX2, | |
456 | & Q2MIN1,Q2MAX1,Q2MIN2,Q2MAX2, | |
457 | & THMIN1,THMAX1,THMIN2,THMAX2, | |
458 | & ITAG1,ITAG2 | |
459 | C cut probability distribution | |
460 | INTEGER IEETA1,IIMAX,KKMAX | |
461 | PARAMETER( IEETA1=20, IIMAX=20, KKMAX=20 ) | |
462 | INTEGER IEEMAX,IMAX,KMAX | |
463 | REAL PROB | |
464 | DOUBLE PRECISION EPTAB | |
465 | COMMON /POPROB/ PROB(4,IEETA1,0:IIMAX,0:KKMAX),EPTAB(4,IEETA1), | |
466 | & IEEMAX,IMAX,KMAX | |
467 | C event weights and generated cross section | |
468 | INTEGER IPOWGC,ISWCUT,IVWGHT | |
469 | DOUBLE PRECISION SIGGEN,HSWGHT,HSWCUT,EVWGHT | |
470 | COMMON /POWGHT/ SIGGEN(4),HSWGHT(0:10),HSWCUT(20),EVWGHT(0:10), | |
471 | & IPOWGC(0:10),ISWCUT(20),IVWGHT(0:10) | |
472 | C names of hard scattering processes | |
473 | INTEGER Max_pro_1 | |
474 | PARAMETER ( Max_pro_1 = 16 ) | |
475 | CHARACTER*18 PROC | |
476 | COMMON /POHPRO/ PROC(0:Max_pro_1) | |
477 | C hard cross sections and MC selection weights | |
478 | INTEGER Max_pro_2 | |
479 | PARAMETER ( Max_pro_2 = 16 ) | |
480 | INTEGER IHa_last,IHb_last,MH_pro_on,MH_tried, | |
481 | & MH_acc_1,MH_acc_2 | |
482 | DOUBLE PRECISION Hfac,HWgx,HSig,Hdpt,HEcm_last,HQ2a_last,HQ2b_last | |
483 | COMMON /POHRCS/ Hfac(-1:Max_pro_2),HWgx(-1:Max_pro_2), | |
484 | & HSig(-1:Max_pro_2),Hdpt(-1:Max_pro_2), | |
485 | & HEcm_last,HQ2a_last,HQ2b_last,IHa_last,IHb_last, | |
486 | & MH_pro_on(-1:Max_pro_2,0:4),MH_tried(-1:Max_pro_2,0:4), | |
487 | & MH_acc_1(-1:Max_pro_2,0:4),MH_acc_2(-1:Max_pro_2,0:4) | |
488 | ||
489 | INTEGER MSTU,MSTJ | |
490 | DOUBLE PRECISION PARU,PARJ | |
491 | COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) | |
492 | INTEGER KCHG | |
493 | DOUBLE PRECISION PMAS,PARF,VCKM | |
494 | COMMON/PYDAT2/KCHG(500,4),PMAS(500,4),PARF(2000),VCKM(4,4) | |
495 | INTEGER MDCY,MDME,KFDP | |
496 | DOUBLE PRECISION BRAT | |
bd378884 | 497 | COMMON/PYDAT3/MDCY(500,3),MDME(8000,2),BRAT(8000),KFDP(8000,5) |
9aaba0d6 | 498 | |
499 | INTEGER PYCOMP | |
500 | ||
501 | DIMENSION ITMP(0:11) | |
502 | CHARACTER*10 CNAME | |
503 | CHARACTER*70 NUMBER,FILENA | |
504 | ||
505 | 14 FORMAT(A10,A69) | |
506 | 15 FORMAT(A12) | |
507 | ||
508 | C define input/output units | |
509 | IF(LINP.GE.0) THEN | |
510 | LI = LINP | |
511 | ELSE | |
512 | LI = 5 | |
513 | ENDIF | |
514 | LO = LOUT | |
515 | ||
516 | IREJ = 0 | |
517 | ||
518 | WRITE(LO,*) | |
519 | WRITE(LO,*) ' ===================================================' | |
520 | WRITE(LO,*) ' ' | |
521 | WRITE(LO,*) ' ---- PHOJET version 1.12 ---- ' | |
522 | WRITE(LO,*) ' ' | |
523 | WRITE(LO,*) ' ===================================================' | |
524 | WRITE(LO,*) ' Authors: Ralph Engel (FZ Karlsruhe)' | |
525 | WRITE(LO,*) ' Johannes Ranft (Siegen Univ.)' | |
526 | WRITE(LO,*) ' Stefan Roesler (CERN)' | |
527 | WRITE(LO,*) ' ---------------------------------------------------' | |
528 | WRITE(LO,*) ' Manual, updates, and further information:' | |
529 | WRITE(LO,*) ' http://www-ik.fzk.de/~engel/phojet.html' | |
530 | WRITE(LO,*) ' ---------------------------------------------------' | |
531 | WRITE(LO,*) ' please send suggestions / bug reports etc. to:' | |
532 | WRITE(LO,*) ' ralph.engel@fzk.de' | |
533 | WRITE(LO,*) ' ===================================================' | |
534 | WRITE(LO,*) ' $Date: 2000/06/25 21:59:19 $' | |
535 | WRITE(LO,*) ' $Revision: 1.12.1.35 $' | |
536 | WRITE(LO,*) ' (code version with interface to PYTHIA 6.x)' | |
537 | WRITE(LO,*) ' (code version for usage in DPMJET 3.x)' | |
538 | WRITE(LO,*) ' ===================================================' | |
539 | WRITE(LO,*) | |
540 | ||
541 | C standard initializations | |
542 | CALL PHO_DATINI | |
543 | CALL PHO_PARDAT | |
544 | DUM = PHO_PMASS(0,-1) | |
545 | ||
546 | C initialize standard PDFs | |
547 | C proton | |
548 | CALL PHO_SETPDF(2212,IDUM,5,6,0,0,-1) | |
549 | CALL PHO_SETPDF(-2212,IDUM,5,6,0,0,-1) | |
550 | C neutron | |
551 | CALL PHO_SETPDF(2112,IDUM,5,6,0,0,-1) | |
552 | CALL PHO_SETPDF(-2112,IDUM,5,6,0,0,-1) | |
553 | C photon | |
554 | CALL PHO_SETPDF(22,IDUM,5,3,0,0,-1) | |
555 | C pomeron | |
556 | CALL PHO_SETPDF(990,IDUM,4,0,0,0,-1) | |
557 | C pions | |
558 | CALL PHO_SETPDF(211,IDUM,5,2,0,0,-1) | |
559 | CALL PHO_SETPDF(-211,IDUM,5,2,0,0,-1) | |
560 | CALL PHO_SETPDF(111,IDUM,5,2,0,0,-1) | |
561 | C kaons | |
562 | CALL PHO_SETPDF(321,IDUM,5,2,0,0,-1) | |
563 | CALL PHO_SETPDF(-321,IDUM,5,2,0,0,-1) | |
564 | CALL PHO_SETPDF(130,IDUM,5,2,0,0,-1) | |
565 | CALL PHO_SETPDF(310,IDUM,5,2,0,0,-1) | |
566 | ||
567 | C nothing to be done | |
568 | IF(LINP.LT.0) RETURN | |
569 | ||
570 | C main loop to read input cards | |
571 | 1200 CONTINUE | |
572 | READ(LINP,14,END=1300) CNAME,NUMBER | |
573 | IF(CNAME.EQ.'ENDINPUT ') THEN | |
574 | GOTO 1300 | |
575 | ELSE IF(CNAME.EQ.'STOP ') THEN | |
576 | WRITE(LO,*) 'STOP' | |
577 | STOP | |
578 | ELSE IF(CNAME.EQ.'COMMENT ') THEN | |
579 | WRITE(LO,'(1X,A10,A69)') 'COMMENT ',NUMBER | |
580 | ELSE IF(CNAME(1:1).EQ.'*') THEN | |
581 | WRITE(LO,'(1X,A10,A69)') CNAME,NUMBER | |
582 | ELSE IF(CNAME.EQ.'PTCUT ') THEN | |
583 | READ(NUMBER,*) PARMDL(36),PARMDL(37),PARMDL(38),PARMDL(39) | |
584 | WRITE(LO,*) 'PTCUT ',PARMDL(36),PARMDL(37), | |
585 | & PARMDL(38),PARMDL(39) | |
586 | ELSE IF(CNAME.EQ.'PROCESS ') THEN | |
587 | READ(NUMBER,*) (IPRON(KK,1),KK=1,8) | |
588 | WRITE(LO,*) 'PROCESS ',(IPRON(KK,1),KK=1,8) | |
589 | ELSE IF(CNAME.EQ.'DIFF-PROC ') THEN | |
590 | READ(NUMBER,*) (ITMP(KK),KK=0,11) | |
591 | WRITE(LO,*) 'DIFF-PROC ',(ITMP(KK),KK=0,8) | |
592 | DO 112 KK=1,8 | |
593 | IPRON(KK,ITMP(0)) = ITMP(KK) | |
594 | 112 CONTINUE | |
595 | ELSE IF(CNAME.EQ.'SUBPROCESS') THEN | |
596 | READ(NUMBER,*) IMPRO,IP,ION | |
597 | WRITE(LO,*) 'SUBPROCESS',IMPRO,IP,ION | |
598 | MH_pro_on(IMPRO,IP) = ION | |
599 | ELSE IF(CNAME.EQ.'PARTICLE1 ') THEN | |
600 | READ(NUMBER,*) IDPDG,PVIR | |
601 | IHFLS(1) = 1 | |
602 | XPSUB = 1.D0 | |
603 | CALL PHO_SETPAR(1,IDPDG,0,PVIR) | |
604 | WRITE(LO,*) 'PARTICLE1 ',IDPDG,PVIR | |
605 | ELSE IF(CNAME.EQ.'PARTICLE2 ') THEN | |
606 | READ(NUMBER,*) IDPDG,PVIR | |
607 | IHFLS(2) = 1 | |
608 | XTSUB = 1.D0 | |
609 | CALL PHO_SETPAR(2,IDPDG,0,PVIR) | |
610 | WRITE(LO,*) 'PARTICLE2 ',IDPDG,PVIR | |
611 | ELSE IF(CNAME.EQ.'REMNANT1 ') THEN | |
612 | READ(NUMBER,*) IDPDG,IFL1,IFL2,IVAL,XSUB | |
613 | IHFLS(1) = IVAL | |
614 | IHFLD(1,1) = IFL1 | |
615 | IHFLD(1,2) = IFL2 | |
616 | XPSUB = XSUB | |
617 | PVIR = 0.D0 | |
618 | CALL PHO_SETPAR(1,IDPDG,-1,PVIR) | |
619 | WRITE(LO,*) 'REMNANT1 ',IDPDG,IFL1,IFL2,IVAL,XSUB | |
620 | ELSE IF(CNAME.EQ.'REMNANT2 ') THEN | |
621 | READ(NUMBER,*) IDPDG,IFL1,IFL2,IVAL,XSUB | |
622 | IHFLS(2) = IVAL | |
623 | IHFLD(2,1) = IFL1 | |
624 | IHFLD(2,2) = IFL2 | |
625 | XTSUB = XSUB | |
626 | PVIR = 0.D0 | |
627 | CALL PHO_SETPAR(2,IDPDG,-1,PVIR) | |
628 | WRITE(LO,*) 'REMNANT2 ',IDPDG,IFL1,IFL2,IVAL,XSUB | |
629 | ELSE IF(CNAME.EQ.'PDF ') THEN | |
630 | READ(NUMBER,*) IDPDG,IPAR,ISET,IEXT | |
631 | WRITE(LO,*) 'PDF ',IDPDG,IPAR,ISET,IEXT | |
632 | CALL PHO_SETPDF(IDPDG,IDUM,IPAR,ISET,IEXT,0,-1) | |
633 | ELSE IF(CNAME.EQ.'SETMODEL ') THEN | |
634 | READ(NUMBER,*) I,IVAL | |
635 | WRITE(LO,*) 'SETMODEL ',I,IVAL | |
636 | CALL PHO_SETMDL(I,IVAL,1) | |
637 | ELSE IF(CNAME.EQ.'SETPARAM ') THEN | |
638 | READ(NUMBER,*) I,PARNEW | |
639 | WRITE(LO,*) 'SETPARAM ',I,PARNEW | |
640 | PARMDL(I) = PARNEW | |
641 | ELSE IF(CNAME.EQ.'DEBUG ') THEN | |
642 | READ(NUMBER,*) IDEBF,IDEBN,IDLEV | |
643 | WRITE(LO,*) 'DEBUG ',IDEBF,IDEBN,IDLEV | |
644 | CALL PHO_TRACE(IDEBF,IDEBN,IDLEV) | |
645 | ELSE IF(CNAME.EQ.'TRACE ') THEN | |
646 | READ(NUMBER,*) IDEBF,IDLEV | |
647 | WRITE(LO,*) 'TRACE ',IDEBF,IDLEV | |
648 | IDEB(IDEBF) = IDLEV | |
649 | ELSE IF(CNAME.EQ.'SETICUT ') THEN | |
650 | READ(NUMBER,*) I,ICUT | |
651 | WRITE(LO,*) 'SETICUT ',I,ICUT | |
652 | ISWCUT(I) = ICUT | |
653 | ELSE IF(CNAME.EQ.'SETFCUT ') THEN | |
654 | READ(NUMBER,*) I,PARNEW | |
655 | WRITE(LO,*) 'SETFCUT ',I,PARNEW | |
656 | HSWCUT(I) = PARNEW | |
657 | ELSE IF(CNAME.EQ.'LUND-MSTU ') THEN | |
658 | READ(NUMBER,*) I,IVAL | |
659 | WRITE(LO,*) 'LUND-MSTU ',I,IVAL | |
660 | MSTU(I) = IVAL | |
661 | ELSE IF(CNAME.EQ.'LUND-MSTJ ') THEN | |
662 | READ(NUMBER,*) I,IVAL | |
663 | WRITE(LO,*) 'LUND-MSTJ ',I,IVAL | |
664 | MSTJ(I) = IVAL | |
665 | ELSE IF(CNAME.EQ.'LUND-PARJ ') THEN | |
666 | READ(NUMBER,*) I,EE | |
667 | WRITE(LO,*) 'LUND-PARJ ',I,EE | |
668 | PARJ(I) = REAL(EE) | |
669 | ELSE IF(CNAME.EQ.'LUND-PARU ') THEN | |
670 | READ(NUMBER,*) I,EE | |
671 | WRITE(LO,*) 'LUND-PARU ',I,EE | |
672 | PARU(I) = REAL(EE) | |
673 | ELSE IF(CNAME.EQ.'LUND-DECAY') THEN | |
674 | READ(NUMBER,*) ID,ION | |
675 | WRITE(LO,*) 'LUND-DECAY ',ID,ION | |
676 | KC=PYCOMP(ID) | |
677 | MDCY(KC,1) = ION | |
678 | ELSE IF(CNAME.EQ.'PSOFTMIN ') THEN | |
679 | READ(NUMBER,*) PSOMIN | |
680 | WRITE(LO,*) 'PSOFTMIN ',PSOMIN | |
681 | ELSE IF(CNAME.EQ.'INTPREC ') THEN | |
682 | READ(NUMBER,*) NGAUP1,NGAUP2,NGAUET,NGAUIN,NGAUSO | |
683 | WRITE(LO,*) 'INTPREC ',NGAUP1,NGAUP2,NGAUET,NGAUIN,NGAUSO | |
684 | ||
685 | C PDF test utility | |
686 | ELSE IF(CNAME.EQ.'PDFTEST ') THEN | |
687 | READ(NUMBER,*) IDPDG,SCALE2,PVIRT2 | |
688 | PVIRT2 = ABS(PVIRT2) | |
689 | WRITE(LO,*) 'PDFTEST ',IDPDG,' ',SCALE2,' ',PVIRT2 | |
690 | CALL PHO_PDFTST(IDPDG,SCALE2,PVIRT2) | |
691 | ||
692 | C mass cut on gamma-gamma or gamma-hadron system | |
693 | ELSE IF(CNAME.EQ.'ECMS-CUT ') THEN | |
694 | READ(NUMBER,*) ECMIN,ECMAX | |
695 | WRITE(LO,*) 'ECMS-CUT ',ECMIN,ECMAX | |
696 | ||
697 | C beam lepton (anti-)tagging system | |
698 | ELSE IF(CNAME.EQ.'TAG-METHOD') THEN | |
699 | READ(NUMBER,*) ITAG1,ITAG2 | |
700 | WRITE(LO,*) 'TAG-METHOD',ITAG1,ITAG2 | |
701 | ELSE IF(CNAME.EQ.'E-TAG1 ') THEN | |
702 | READ(NUMBER,*) | |
703 | & EEMIN1,YMIN1,YMAX1,Q2MIN1,Q2MAX1,THMIN1,THMAX1 | |
704 | WRITE(LO,*) 'E-TAG1 ',EEMIN1,YMIN1,YMAX1, | |
705 | & Q2MIN1,Q2MAX1,THMIN1,THMAX1 | |
706 | ELSE IF(CNAME.EQ.'E-TAG2 ') THEN | |
707 | READ(NUMBER,*) | |
708 | & EEMIN2,YMIN2,YMAX2,Q2MIN2,Q2MAX2,THMIN2,THMAX2 | |
709 | WRITE(LO,*) 'E-TAG2 ',EEMIN2,YMIN2,YMAX2, | |
710 | & Q2MIN2,Q2MAX2,THMIN2,THMAX2 | |
711 | ||
712 | C sampling of gamma-p events in ep (HERA) | |
713 | ELSE IF( (CNAME.EQ.'WW-HERA ') | |
714 | & .OR.(CNAME.EQ.'GP-HERA ')) THEN | |
715 | READ(NUMBER,*) EE1,EE2,NEV | |
716 | WRITE(LO,*) 'GP-HERA ',EE1,EE2,NEV | |
717 | IF(YMAX2.LT.0.D0) THEN | |
718 | WRITE(LO,*) ' PHO_INIT:ERROR:ELECTRON TAGGER NOT SET' | |
719 | ELSE | |
720 | CALL PHO_GPHERA(NEV,EE1,EE2) | |
721 | KEVENT = 0 | |
722 | ENDIF | |
723 | ||
724 | C sampling of gamma-gamma events in e+e- (LEP) | |
725 | ELSE IF( (CNAME.EQ.'GG-EPEM ') | |
726 | & .OR.(CNAME.EQ.'WW-EPEM ')) THEN | |
727 | READ(NUMBER,*) EE1,EE2,NEV | |
728 | WRITE(LO,*) 'GG-EPEM ',EE1,EE2,NEV | |
729 | IF((YMAX1.LT.0.D0).OR.(YMAX2.LT.0.D0)) THEN | |
730 | WRITE(LO,*) ' PHO_INIT:ERROR:ELECTRON TAGGERS NOT SET' | |
731 | ELSE | |
732 | CALL PHO_GGEPEM(-1,EE1,EE2) | |
733 | CALL PHO_GGEPEM(NEV,EE1,EE2) | |
734 | CALL PHO_GGEPEM(-2,sig_tot,sig_gg) | |
735 | KEVENT = 0 | |
736 | ENDIF | |
737 | ||
738 | C sampling of gamma-gamma in heavy-ion collisions | |
739 | ELSE IF(CNAME.EQ.'GG-HION-F ') THEN | |
740 | READ(NUMBER,*) EE,NA,NZ,NEV | |
741 | WRITE(LO,*) 'GG-HION-F ',EE,NA,NZ,NEV | |
742 | IF((YMAX1.LT.0.D0).OR.(YMAX2.LT.0.D0)) THEN | |
743 | WRITE(LO,*) ' PHO_INIT:ERROR:Y RANGE FOR PHOTONS NOT SET' | |
744 | ELSE | |
745 | CALL PHO_GGHIOF(NEV,EE,NA,NZ) | |
746 | KEVENT = 0 | |
747 | ENDIF | |
748 | ELSE IF(CNAME.EQ.'GG-HION-G ') THEN | |
749 | READ(NUMBER,*) EE,NA,NZ,NEV | |
750 | WRITE(LO,*) 'GG-HION-G ',EE,NA,NZ,NEV | |
751 | IF((YMAX1.LT.0.D0).OR.(YMAX2.LT.0.D0)) THEN | |
752 | WRITE(LO,*) ' PHO_INIT:ERROR:Y RANGE FOR PHOTONS NOT SET' | |
753 | ELSE | |
754 | CALL PHO_GGHIOG(NEV,EE,NA,NZ) | |
755 | KEVENT = 0 | |
756 | ENDIF | |
757 | ||
758 | C sampling of gamma-hadron events in heavy ion collisions | |
759 | ELSE IF(CNAME.EQ.'GH-HION-F ') THEN | |
760 | READ(NUMBER,*) EE,NA,NZ,NEV | |
761 | WRITE(LO,*) 'GH-HION-F ',EE,NA,NZ,NEV | |
762 | IF((YMAX1.LT.0.D0).OR.(YMAX2.LT.0.D0)) THEN | |
763 | WRITE(LO,*) ' PHO_INIT:ERROR:Y RANGE FOR PHOTONS NOT SET' | |
764 | ELSE | |
765 | CALL PHO_GHHIOF(NEV,EE,NA,NZ) | |
766 | KEVENT = 0 | |
767 | ENDIF | |
768 | ||
769 | C sampling of hadron-gamma events in hadron - heavy ion collisions | |
770 | ELSE IF(CNAME.EQ.'HG-HIAS-F ') THEN | |
771 | READ(NUMBER,*) EP,EE,NA,NZ,NEV | |
772 | WRITE(LO,*) 'HG-HIAS-F ',EP,EE,NA,NZ,NEV | |
773 | IF(YMAX2.LT.0.D0) THEN | |
774 | WRITE(LO,*) ' PHO_INIT:ERROR:Y RANGE FOR PHOTONS NOT SET' | |
775 | ELSE | |
776 | CALL PHO_GHHIAS(NEV,EP,EE,NA,NZ) | |
777 | KEVENT = 0 | |
778 | ENDIF | |
779 | ||
780 | C sampling of photoproduction events e+e-, backscattered laser | |
781 | ELSE IF(CNAME.EQ.'BLASER ') THEN | |
782 | READ(NUMBER,*) EE1,EE2,Pl_lam_1,Pl_lam_2,X_1,X_2,rho,A,NEV | |
783 | WRITE(LO,*) 'BLASER ',EE1,EE2, | |
784 | & Pl_lam_1,Pl_lam_2,X_1,X_2,rho,A,NEV | |
785 | CALL PHO_GGBLSR(NEV,EE1,EE2,Pl_lam_1,Pl_lam_2,X_1,X_2,rho,A) | |
786 | KEVENT = 0 | |
787 | ||
788 | C sampling of photoproduction events beamstrahlung | |
789 | ELSE IF(CNAME.EQ.'BEAMST ') THEN | |
790 | READ(NUMBER,*) EE1,YPSI,SIGX,SIGY,SIGZ,AEB,NEV | |
791 | WRITE(LO,*) 'BEAMST ',EE1,YPSI,SIGX,SIGY,SIGZ,AEB,NEV | |
792 | IF(YMAX1.LT.0.D0) THEN | |
793 | WRITE(LO,*) ' PHO_INIT:ERROR:ELECTRON TAGGER 1 NOT SET' | |
794 | ELSE | |
795 | CALL PHO_GGBEAM(NEV,EE1,YPSI,SIGX,SIGY,SIGZ,AEB) | |
796 | KEVENT = 0 | |
797 | ENDIF | |
798 | ||
799 | C fixed-energy events in LAB system of particle 2 | |
800 | ELSE IF(CNAME.EQ.'EVENT-LAB ') THEN | |
801 | READ(NUMBER,*) PLAB,NEV | |
802 | WRITE(LO,*) 'EVENT-LAB ',PLAB,NEV | |
803 | CALL PHO_FIXLAB(PLAB,NEV) | |
804 | KEVENT = 0 | |
805 | ||
806 | C fixed-energy events in CM system | |
807 | ELSE IF(CNAME.EQ.'EVENT-CMS ') THEN | |
808 | READ(NUMBER,*) ECM,NEV | |
809 | WRITE(LO,*) 'EVENT-CMS ',ECM,NEV | |
810 | PMASS1 = PHO_PMASS(IFPAB(1),0)-SQRT(PVIRT(1)) | |
811 | PMASS2 = PHO_PMASS(IFPAB(2),0)-SQRT(PVIRT(2)) | |
812 | CALL PHO_PECMS(1,PMASS1,PMASS2,ECM,PCM,EE) | |
813 | E1 = EE | |
814 | E2 = ECM-EE | |
815 | THETA = 0.D0 | |
816 | PHI = 0.D0 | |
817 | CALL PHO_FIXCOL(E1,E2,THETA,PHI,NEV) | |
818 | KEVENT = 0 | |
819 | ||
820 | C fixed-energy events for collider setup with crossing angle | |
821 | ELSE IF(CNAME.EQ.'EVENT-COLL') THEN | |
822 | READ(NUMBER,*) E1,E2,THETA,PHI,NEV | |
823 | WRITE(LO,*) 'EVENT-COLL',E1,E2,THETA,PHI,NEV | |
824 | CALL PHO_FIXCOL(E1,E2,THETA,PHI,NEV) | |
825 | KEVENT = 0 | |
826 | ||
827 | C unknown data card | |
828 | ELSE | |
829 | WRITE(LO,*) 'PHO_INIT: unknown data card: ',CNAME,NUMBER | |
830 | ENDIF | |
831 | ||
832 | GOTO 1200 | |
833 | 1300 CONTINUE | |
834 | WRITE(LO,*) ' RETURN' | |
835 | ||
836 | END | |
837 | ||
838 | *$ CREATE PHO_SETMDL.FOR | |
839 | *COPY PHO_SETMDL | |
840 | CDECK ID>, PHO_SETMDL | |
841 | SUBROUTINE PHO_SETMDL(INDX,IVAL,IMODE) | |
842 | C********************************************************************** | |
843 | C | |
844 | C set model switches | |
845 | C | |
846 | C input: INDX model parameter number | |
847 | C (positive: ISWMDL, negative: IPAMDL) | |
848 | C IVAL new value | |
849 | C IMODE -1 print value of parameter INDX | |
850 | C 1 set new value | |
851 | C -2 print current settings | |
852 | C | |
853 | C********************************************************************** | |
854 | IMPLICIT DOUBLE PRECISION (A-H,O-Z) | |
855 | SAVE | |
856 | ||
857 | C input/output channels | |
858 | INTEGER LI,LO | |
859 | COMMON /POINOU/ LI,LO | |
860 | C model switches and parameters | |
861 | CHARACTER*8 MDLNA | |
862 | INTEGER ISWMDL,IPAMDL | |
863 | DOUBLE PRECISION PARMDL | |
864 | COMMON /POMDLS/ MDLNA(50),ISWMDL(50),PARMDL(400),IPAMDL(400) | |
865 | ||
866 | IF(IMODE.EQ.-2) THEN | |
867 | WRITE(LO,'(/1X,A,/1X,A,/)') 'PHO_SETMDL: current settings', | |
868 | & '----------------------------' | |
869 | DO 100 I=1,48,3 | |
870 | IF(ISWMDL(I).EQ.-9999) GOTO 200 | |
871 | IF(ISWMDL(I+1).EQ.-9999) THEN | |
872 | WRITE(LO,'(5X,I3,A1,A,I6)') I,':',MDLNA(I),ISWMDL(I) | |
873 | GOTO 200 | |
874 | ELSE IF(ISWMDL(I+2).EQ.-9999) THEN | |
875 | WRITE(LO,'(2(5X,I3,A1,A,I6))') I,':',MDLNA(I),ISWMDL(I), | |
876 | & I+1,':',MDLNA(I+1),ISWMDL(I+1) | |
877 | GOTO 200 | |
878 | ELSE | |
879 | WRITE(LO,'(3(5X,I3,A1,A,I6))') | |
880 | & (I+K,':',MDLNA(I+K),ISWMDL(I+K),K=0,2) | |
881 | ENDIF | |
882 | 100 CONTINUE | |
883 | 200 CONTINUE | |
884 | ELSE IF(IMODE.EQ.-1) THEN | |
885 | WRITE(LO,'(1X,A,1X,A,I6)') | |
886 | & 'PHO_SETMDL:',MDLNA(INDX),ISWMDL(INDX) | |
887 | ELSE IF(IMODE.EQ.1) THEN | |
888 | IF(INDX.GT.0) THEN | |
889 | IF(ISWMDL(INDX).NE.IVAL) THEN | |
890 | WRITE(LO,'(1X,A,I4,1X,A,2I6)') | |
891 | & 'PHO_SETMDL:ISWMDL(OLD/NEW):', | |
892 | & INDX,MDLNA(INDX),ISWMDL(INDX),IVAL | |
893 | ISWMDL(INDX) = IVAL | |
894 | ENDIF | |
895 | ELSE IF(INDX.LT.0) THEN | |
896 | IF(IPAMDL(-INDX).NE.IVAL) THEN | |
897 | WRITE(LO,'(1X,A,I4,1X,2I6)') 'PHO_SETMDL:IPAMDL(OLD/NEW):', | |
898 | & -INDX,IPAMDL(-INDX),IVAL | |
899 | IPAMDL(-INDX) = IVAL | |
900 | ENDIF | |
901 | ENDIF | |
902 | ELSE | |
903 | WRITE(LO,'(/1X,A,I6)') | |
904 | & 'PHO_SETMDL:ERROR: unsupported mode',IMODE | |
905 | ENDIF | |
906 | END | |
907 | ||
908 | *$ CREATE PHO_DATINI.FOR | |
909 | *COPY PHO_DATINI | |
910 | CDECK ID>, PHO_DATINI | |
911 | SUBROUTINE PHO_DATINI | |
912 | C********************************************************************* | |
913 | C | |
914 | C initialization of variables and switches | |
915 | C | |
916 | C********************************************************************* | |
917 | IMPLICIT DOUBLE PRECISION (A-H,O-Z) | |
918 | SAVE | |
919 | ||
920 | C input/output channels | |
921 | INTEGER LI,LO | |
922 | COMMON /POINOU/ LI,LO | |
923 | C some constants | |
924 | DOUBLE PRECISION PI,PI2,PI4,GEV2MB,Q_ch,Q_ch2,Q_ch4 | |
925 | COMMON /POCONS/ PI,PI2,PI4,GEV2MB, | |
926 | & Q_ch(-6:6),Q_ch2(-6:6),Q_ch4(-6:6) | |
927 | C event debugging information | |
928 | INTEGER NMAXD | |
929 | PARAMETER (NMAXD=100) | |
930 | INTEGER IDEB,KSPOM,KHPOM,KSREG,KHDIR,KACCEP,KSTRG,KHTRG,KSLOO, | |
931 | & KHLOO,KSDPO,KHDPO,KEVENT,KSOFT,KHARD | |
932 | COMMON /PODEBG/ IDEB(NMAXD),KSPOM,KHPOM,KSREG,KHDIR,KACCEP,KSTRG, | |
933 | & KHTRG,KSLOO,KHLOO,KSDPO,KHDPO,KEVENT,KSOFT,KHARD | |
934 | C event weights and generated cross section | |
935 | INTEGER IPOWGC,ISWCUT,IVWGHT | |
936 | DOUBLE PRECISION SIGGEN,HSWGHT,HSWCUT,EVWGHT | |
937 | COMMON /POWGHT/ SIGGEN(4),HSWGHT(0:10),HSWCUT(20),EVWGHT(0:10), | |
938 | & IPOWGC(0:10),ISWCUT(20),IVWGHT(0:10) | |
939 | C scale parameters for parton model calculations | |
940 | INTEGER NQQAL,NQQALI,NQQALF,NQQPD | |
941 | DOUBLE PRECISION AQQAL,AQQALI,AQQALF,AQQPD | |
942 | COMMON /POHSCL/ AQQAL,AQQALI,AQQALF,AQQPD, | |
943 | & NQQAL,NQQALI,NQQALF,NQQPD | |
944 | C integration precision for hard cross sections (obsolete) | |
945 | INTEGER NGAUP1,NGAUP2,NGAUET,NGAUIN,NGAUSO | |
946 | COMMON /POGAUP/ NGAUP1,NGAUP2,NGAUET,NGAUIN,NGAUSO | |
947 | C hard scattering parameters used for most recent hard interaction | |
948 | INTEGER NFbeta,NF | |
949 | DOUBLE PRECISION ALQCD2,BQCD | |
950 | COMMON /POHAPA/ ALQCD2(3,4),BQCD(4),NFbeta,NF | |
951 | C cut probability distribution | |
952 | INTEGER IEETA1,IIMAX,KKMAX | |
953 | PARAMETER( IEETA1=20, IIMAX=20, KKMAX=20 ) | |
954 | INTEGER IEEMAX,IMAX,KMAX | |
955 | REAL PROB | |
956 | DOUBLE PRECISION EPTAB | |
957 | COMMON /POPROB/ PROB(4,IEETA1,0:IIMAX,0:KKMAX),EPTAB(4,IEETA1), | |
958 | & IEEMAX,IMAX,KMAX | |
959 | C gamma-lepton or gamma-hadron vertex information | |
960 | INTEGER IGHEL,IDPSRC,IDBSRC | |
961 | DOUBLE PRECISION PINI,PFIN,PGAM,GYY,GQ2,GGECM,GAIMP,PFTHE,PFPHI, | |
962 | & RADSRC,AMSRC,GAMSRC | |
963 | COMMON /POFSRC/ PINI(5,2),PFIN(5,2),PGAM(5,2),IGHEL(2), | |
964 | & GYY(2),GQ2(2),GGECM,GAIMP(2),PFTHE(2),PFPHI(2), | |
965 | & IDPSRC(2),IDBSRC(2),RADSRC(2),AMSRC(2),GAMSRC(2) | |
966 | C photon flux kinematics and cuts | |
967 | DOUBLE PRECISION ECMIN,ECMAX,EEMIN1,EEMIN2, | |
968 | & YMIN1,YMAX1,YMIN2,YMAX2, | |
969 | & Q2MIN1,Q2MAX1,Q2MIN2,Q2MAX2, | |
970 | & THMIN1,THMAX1,THMIN2,THMAX2 | |
971 | INTEGER ITAG1,ITAG2 | |
972 | COMMON /POFCUT/ ECMIN,ECMAX,EEMIN1,EEMIN2, | |
973 | & YMIN1,YMAX1,YMIN2,YMAX2, | |
974 | & Q2MIN1,Q2MAX1,Q2MIN2,Q2MAX2, | |
975 | & THMIN1,THMAX1,THMIN2,THMAX2, | |
976 | & ITAG1,ITAG2 | |
977 | C obsolete cut-off information | |
978 | DOUBLE PRECISION PTCUT,PTANO,FPS,FPH,PSOMIN,XSOMIN | |
979 | COMMON /POCUT1/ PTCUT(4),PTANO(4),FPS(4),FPH(4),PSOMIN,XSOMIN | |
980 | C global event kinematics and particle IDs | |
981 | INTEGER IFPAP,IFPAB | |
982 | DOUBLE PRECISION ECM,PCM,PMASS,PVIRT | |
983 | COMMON /POGCMS/ ECM,PCM,PMASS(2),PVIRT(2),IFPAP(2),IFPAB(2) | |
984 | C nucleon-nucleus / nucleus-nucleus interface to DPMJET | |
985 | INTEGER IDEQP,IDEQB,IHFLD,IHFLS | |
986 | DOUBLE PRECISION ECMN,PCMN,SECM,SPCM,XPSUB,XTSUB | |
987 | COMMON /POHDFL/ ECMN,PCMN,SECM,SPCM,XPSUB,XTSUB, | |
988 | & IDEQP(2),IDEQB(2),IHFLD(2,2),IHFLS(2) | |
989 | C some hadron information, will be deleted in future versions | |
990 | INTEGER NFS | |
991 | DOUBLE PRECISION QMASS,BET,PCOUDI,PNORM,VALPRG | |
992 | COMMON /POHDRN/ QMASS(6),BET,PCOUDI,PNORM,VALPRG(2),NFS | |
993 | C model switches and parameters | |
994 | CHARACTER*8 MDLNA | |
995 | INTEGER ISWMDL,IPAMDL | |
996 | DOUBLE PRECISION PARMDL | |
997 | COMMON /POMDLS/ MDLNA(50),ISWMDL(50),PARMDL(400),IPAMDL(400) | |
998 | C general process information | |
999 | INTEGER IPROCE,IDNODF,IDIFR1,IDIFR2,IDDPOM,IPRON | |
1000 | COMMON /POPRCS/ IPROCE,IDNODF,IDIFR1,IDIFR2,IDDPOM,IPRON(15,4) | |
1001 | C parameters of the "simple" Vector Dominance Model | |
1002 | DOUBLE PRECISION VMAS,GAMM,RMIN,RMAX,VMSL,VMFA | |
1003 | COMMON /POSVDM/ VMAS(4),GAMM(4),RMIN(4),RMAX(4),VMSL(4),VMFA(4) | |
1004 | C parameters for DGLAP backward evolution in ISR | |
1005 | INTEGER NFSISR | |
1006 | DOUBLE PRECISION Q2MISR,PMISR,ZMISR,AL2ISR | |
1007 | COMMON /PODGL1/ Q2MISR(2),PMISR(2),ZMISR(2),AL2ISR(2),NFSISR | |
1008 | C particles created by initial state evolution | |
1009 | INTEGER MXISR1,MXISR2 | |
1010 | PARAMETER ( MXISR1 = 150, MXISR2 = 50 ) | |
1011 | INTEGER IFLISR,IPOISR,IMXISR | |
1012 | DOUBLE PRECISION PHISR | |
1013 | COMMON /POPISR/ IFLISR(2,MXISR1),PHISR(2,4,MXISR1), | |
1014 | & IPOISR(2,2,MXISR2),IMXISR(2) | |
1015 | C names of hard scattering processes | |
1016 | INTEGER Max_pro_1 | |
1017 | PARAMETER ( Max_pro_1 = 16 ) | |
1018 | CHARACTER*18 PROC | |
1019 | COMMON /POHPRO/ PROC(0:Max_pro_1) | |
1020 | C hard cross sections and MC selection weights | |
1021 | INTEGER Max_pro_2 | |
1022 | PARAMETER ( Max_pro_2 = 16 ) | |
1023 | INTEGER IHa_last,IHb_last,MH_pro_on,MH_tried, | |
1024 | & MH_acc_1,MH_acc_2 | |
1025 | DOUBLE PRECISION Hfac,HWgx,HSig,Hdpt,HEcm_last,HQ2a_last,HQ2b_last | |
1026 | COMMON /POHRCS/ Hfac(-1:Max_pro_2),HWgx(-1:Max_pro_2), | |
1027 | & HSig(-1:Max_pro_2),Hdpt(-1:Max_pro_2), | |
1028 | & HEcm_last,HQ2a_last,HQ2b_last,IHa_last,IHb_last, | |
1029 | & MH_pro_on(-1:Max_pro_2,0:4),MH_tried(-1:Max_pro_2,0:4), | |
1030 | & MH_acc_1(-1:Max_pro_2,0:4),MH_acc_2(-1:Max_pro_2,0:4) | |
1031 | C interpolation tables for hard cross section and MC selection weights | |
1032 | INTEGER Max_tab_E,Max_tab_Q2,Max_pro_tab | |
1033 | PARAMETER ( Max_tab_E = 20, Max_tab_Q2 = 10, Max_pro_tab = 16 ) | |
1034 | INTEGER IH_Q2a_up,IH_Q2b_up,IH_Ecm_up | |
1035 | DOUBLE PRECISION Hfac_tab,HWgx_tab,HSig_tab,Hdpt_tab, | |
1036 | & HQ2a_tab,HQ2b_tab,HEcm_tab | |
1037 | COMMON /POHTAB/ | |
1038 | & Hfac_tab(-1:Max_pro_tab,Max_tab_E,Max_tab_Q2,Max_tab_Q2,0:4), | |
1039 | & HWgx_tab(-1:Max_pro_tab,Max_tab_E,Max_tab_Q2,Max_tab_Q2,0:4), | |
1040 | & HSig_tab(-1:Max_pro_tab,Max_tab_E,Max_tab_Q2,Max_tab_Q2,0:4), | |
1041 | & Hdpt_tab(-1:Max_pro_tab,Max_tab_E,Max_tab_Q2,Max_tab_Q2,0:4), | |
1042 | & HQ2a_tab(1:Max_tab_Q2,0:4),HQ2b_tab(1:Max_tab_Q2,0:4), | |
1043 | & HEcm_tab(1:Max_tab_E,0:4), | |
1044 | & IH_Q2a_up(0:4),IH_Q2b_up(0:4),IH_Ecm_up(0:4) | |
1045 | ||
1046 | C initialize /POCONS/ | |
1047 | PI = ATAN(1.D0)*4.D0 | |
1048 | PI2 = 2.D0*PI | |
1049 | PI4 = 2.D0*PI2 | |
1050 | C GeV**-2 --> millibarn (multiply by GEV2MB to get mb as units) | |
1051 | GEV2MB = 0.389365D0 | |
1052 | C precalculate quark charges | |
1053 | do i=1,6 | |
1054 | Q_ch(i) = dble(2-3*mod(i,2))/3.D0 | |
1055 | Q_ch(-i) = -Q_ch(i) | |
1056 | ||
1057 | Q_ch2(i) = Q_ch(i)**2 | |
1058 | Q_ch2(-i) = Q_ch2(i) | |
1059 | ||
1060 | Q_ch4(i) = Q_ch2(i)**2 | |
1061 | Q_ch4(-i) = Q_ch4(i) | |
1062 | enddo | |
1063 | Q_ch(0) = 0.D0 | |
1064 | Q_ch2(0) = 0.D0 | |
1065 | Q_ch4(0) = 0.D0 | |
1066 | ||
1067 | C initialize /GLOCMS/ | |
1068 | ECM = 50.D0 | |
1069 | PMASS(1) = 0.D0 | |
1070 | PVIRT(1) = 0.D0 | |
1071 | PMASS(2) = 0.D0 | |
1072 | PVIRT(2) = 0.D0 | |
1073 | IFPAP(1) = 22 | |
1074 | IFPAP(2) = 22 | |
1075 | C initialize /HADVAL/ | |
1076 | IHFLD(1,1) = 0 | |
1077 | IHFLD(1,2) = 0 | |
1078 | IHFLD(2,1) = 0 | |
1079 | IHFLD(2,2) = 0 | |
1080 | IHFLS(1) = 1 | |
1081 | IHFLS(2) = 1 | |
1082 | C initialize /MODELS/ | |
1083 | ISWMDL(1) = 3 | |
1084 | MDLNA(1) = 'AMPL MOD' | |
1085 | ISWMDL(2) = 1 | |
1086 | MDLNA(2) = 'MIN-BIAS' | |
1087 | ISWMDL(3) = 1 | |
1088 | MDLNA(3) = 'PTS DISH' | |
1089 | ISWMDL(4) = 1 | |
1090 | MDLNA(4) = 'PTS DISP' | |
1091 | ISWMDL(5) = 2 | |
1092 | MDLNA(5) = 'PTS ASSI' | |
1093 | ISWMDL(6) = 3 | |
1094 | MDLNA(6) = 'HADRONIZ' | |
1095 | ISWMDL(7) = 2 | |
1096 | MDLNA(7) = 'MASS COR' | |
1097 | ISWMDL(8) = 3 | |
1098 | MDLNA(8) = 'PAR SHOW' | |
1099 | ISWMDL(9) = 0 | |
1100 | MDLNA(9) = 'GLU SPLI' | |
1101 | ISWMDL(10) = 2 | |
1102 | MDLNA(10) = 'VIRT PHO' | |
1103 | ISWMDL(11) = 0 | |
1104 | MDLNA(11) = 'LARGE NC' | |
1105 | ISWMDL(12) = 0 | |
1106 | MDLNA(12) = 'LIPA POM' | |
1107 | ISWMDL(13) = 1 | |
1108 | MDLNA(13) = 'QELAS VM' | |
1109 | ISWMDL(14) = 2 | |
1110 | MDLNA(14) = 'ENHA GRA' | |
1111 | ISWMDL(15) = 4 | |
1112 | MDLNA(15) = 'MULT SCA' | |
1113 | ISWMDL(16) = 4 | |
1114 | MDLNA(16) = 'MULT DIF' | |
1115 | ISWMDL(17) = 4 | |
1116 | MDLNA(17) = 'MULT CDF' | |
1117 | ISWMDL(18) = 0 | |
1118 | MDLNA(18) = 'BALAN PT' | |
1119 | ISWMDL(19) = 1 | |
1120 | MDLNA(19) = 'POMV FLA' | |
1121 | ISWMDL(20) = 0 | |
1122 | MDLNA(20) = 'SEA FLA' | |
1123 | ISWMDL(21) = 2 | |
1124 | MDLNA(21) = 'SPIN DEC' | |
1125 | ISWMDL(22) = 1 | |
1126 | MDLNA(22) = 'DIF.MASS' | |
1127 | ISWMDL(23) = 1 | |
1128 | MDLNA(23) = 'DIFF RES' | |
1129 | ISWMDL(24) = 0 | |
1130 | MDLNA(24) = 'PTS HPOM' | |
1131 | ISWMDL(25) = 0 | |
1132 | MDLNA(25) = 'POM CORR' | |
1133 | ISWMDL(26) = 1 | |
1134 | MDLNA(26) = 'OVERLAP ' | |
1135 | ISWMDL(27) = 0 | |
1136 | MDLNA(27) = 'MUL R/AN' | |
1137 | ISWMDL(28) = 1 | |
1138 | MDLNA(28) = 'SUR PROB' | |
1139 | ISWMDL(29) = 1 | |
1140 | MDLNA(29) = 'PRIMO KT' | |
1141 | ISWMDL(30) = 0 | |
1142 | MDLNA(30) = 'DIFF. CS' | |
1143 | ISWMDL(31) = -9999 | |
1144 | C mass-independent sea flavour ratios (for low-mass strings) | |
1145 | PARMDL(1) = 0.425D0 | |
1146 | PARMDL(2) = 0.425D0 | |
1147 | PARMDL(3) = 0.15D0 | |
1148 | PARMDL(4) = 0.D0 | |
1149 | PARMDL(5) = 0.D0 | |
1150 | PARMDL(6) = 0.D0 | |
1151 | C suppression by energy momentum conservation | |
1152 | PARMDL(8) = 9.D0 | |
1153 | PARMDL(9) = 7.D0 | |
1154 | C VDM factors | |
1155 | PARMDL(10) = 0.866D0 | |
1156 | PARMDL(11) = 0.288D0 | |
1157 | PARMDL(12) = 0.288D0 | |
1158 | PARMDL(13) = 0.288D0 | |
1159 | PARMDL(14) = 0.866D0 | |
1160 | PARMDL(15) = 0.288D0 | |
1161 | PARMDL(16) = 0.288D0 | |
1162 | PARMDL(17) = 0.288D0 | |
1163 | PARMDL(18) = 0.D0 | |
1164 | C lower energy limit for initialization | |
1165 | PARMDL(19) = 5.D0 | |
1166 | C soft pt for hard scattering remnants | |
1167 | PARMDL(20) = 5.D0 | |
1168 | C low energy beta of soft pt distribution 1 | |
1169 | PARMDL(21) = 4.5D0 | |
1170 | C high energy beta of soft pt distribution 1 | |
1171 | PARMDL(22) = 3.0D0 | |
1172 | C low energy beta of soft pt distribution 0 | |
1173 | PARMDL(23) = 2.5D0 | |
1174 | C high energy beta of soft pt distribution 0 | |
1175 | PARMDL(24) = 0.4D0 | |
1176 | C effective quark mass in photon wave function | |
1177 | PARMDL(25) = 0.2D0 | |
1178 | C normalization of unevolved Pomeron PDFs | |
1179 | PARMDL(26) = 0.3D0 | |
1180 | C effective VDM parameters for Q**2 dependence of cross section | |
1181 | PARMDL(27) = 0.65D0 | |
1182 | PARMDL(28) = 0.08D0 | |
1183 | PARMDL(29) = 0.05D0 | |
1184 | PARMDL(30) = 0.22D0 | |
1185 | PARMDL(31) = 0.589824D0 | |
1186 | PARMDL(32) = 0.609961D0 | |
1187 | PARMDL(33) = 1.038361D0 | |
1188 | PARMDL(34) = 1.96D0 | |
1189 | C Q**2 suppression of multiple interactions | |
1190 | PARMDL(35) = 0.59D0 | |
1191 | C pt cutoff defaults | |
1192 | PARMDL(36) = 2.5D0 | |
1193 | PARMDL(37) = 2.5D0 | |
1194 | PARMDL(38) = 2.5D0 | |
1195 | PARMDL(39) = 2.5D0 | |
1196 | C enhancement factor for diffractive cross sections | |
1197 | PARMDL(40) = 1.D0 | |
1198 | PARMDL(41) = 1.D0 | |
1199 | PARMDL(42) = 1.D0 | |
1200 | C mass in soft pt distribution | |
1201 | PARMDL(43) = 0.D0 | |
1202 | C maximum of x allowed for leading particle | |
1203 | PARMDL(44) = 0.9D0 | |
1204 | C max. mass sampled in diffraction | |
1205 | PARMDL(45) = sqrt(0.4D0) | |
1206 | C mass threshold in diffraction (2pi mass) | |
1207 | PARMDL(46) = 0.3D0 | |
1208 | C regularization of slope parameter in diffraction | |
1209 | PARMDL(47) = 4.D0 | |
1210 | C renormalized intercept for enhanced graphs | |
1211 | PARMDL(48) = 1.08D0 | |
1212 | C coherence constraint for diff. cross sections | |
1213 | PARMDL(49) = sqrt(0.05D0) | |
1214 | C exponents of x distributions | |
1215 | C baryon | |
1216 | PARMDL(50) = 1.5D0 | |
1217 | PARMDL(51) = -0.5D0 | |
1218 | PARMDL(52) = -0.99D0 | |
1219 | PARMDL(53) = -0.99D0 | |
1220 | C meson (non-strangeness part) | |
1221 | PARMDL(54) = -0.5D0 | |
1222 | PARMDL(55) = -0.5D0 | |
1223 | PARMDL(56) = -0.99D0 | |
1224 | PARMDL(57) = -0.99D0 | |
1225 | C meson (strangeness part) | |
1226 | PARMDL(58) = -0.2D0 | |
1227 | PARMDL(59) = -0.2D0 | |
1228 | PARMDL(60) = -0.99D0 | |
1229 | PARMDL(61) = -0.99D0 | |
1230 | C particle remnant (no valence quarks) | |
1231 | PARMDL(62) = -0.5D0 | |
1232 | PARMDL(63) = -0.5D0 | |
1233 | PARMDL(64) = -0.99D0 | |
1234 | PARMDL(65) = -0.99D0 | |
1235 | C ratio beetween triple-pomeron/reggeon couplings grrp/gppp | |
1236 | PARMDL(66) = 10.D0 | |
1237 | C ratio beetween triple-pomeron/reggeon couplings gppr/gppp | |
1238 | PARMDL(67) = 10.D0 | |
1239 | C min. abs(t) in diffraction | |
1240 | PARMDL(68) = 0.D0 | |
1241 | C max. abs(t) in diffraction | |
1242 | PARMDL(69) = 10.D0 | |
1243 | C min. mass for elastic pomerons in central diffraction | |
1244 | PARMDL(70) = 2.D0 | |
1245 | C min. mass of diffractive blob in central diffraction | |
1246 | PARMDL(71) = 2.D0 | |
1247 | C min. Feynman x cut in central diffraction | |
1248 | PARMDL(72) = 0.D0 | |
1249 | C direct pomeron coupling | |
1250 | PARMDL(74) = 0.D0 | |
1251 | C relative deviation allowed for energy-momentum conservation | |
1252 | C energy-momentum relative deviation | |
1253 | PARMDL(75) = 0.01D0 | |
1254 | C transverse momentum deviation | |
1255 | PARMDL(76) = 0.01D0 | |
1256 | C couplings for unitarization in diffraction | |
1257 | C non-unitarized pomeron coupling (sqrt(mb)) | |
1258 | PARMDL(77) = 3.D0 | |
1259 | C rescaling factor for pomeron PDF | |
1260 | PARMDL(78) = 3.D0 | |
1261 | C coupling probabilities | |
1262 | PARMDL(79) = 1.D0 | |
1263 | PARMDL(80) = 0.D0 | |
1264 | C scales to calculate alpha-s of matrix element | |
1265 | PARMDL(81) = 1.D0 | |
1266 | PARMDL(82) = 1.D0 | |
1267 | PARMDL(83) = 1.D0 | |
1268 | C scales to calculate alpha-s of initial state radiation | |
1269 | PARMDL(84) = 1.D0 | |
1270 | PARMDL(85) = 1.D0 | |
1271 | PARMDL(86) = 1.D0 | |
1272 | C scales to calculate alpha-s of final state radiation | |
1273 | PARMDL(87) = 1.D0 | |
1274 | PARMDL(88) = 1.D0 | |
1275 | PARMDL(89) = 1.D0 | |
1276 | C scales to calculate PDFs | |
1277 | PARMDL(90) = 1.D0 | |
1278 | PARMDL(91) = 1.D0 | |
1279 | PARMDL(92) = 1.D0 | |
1280 | C scale for ISR starting virtuality | |
1281 | PARMDL(93) = 1.D0 | |
1282 | C min. virtuality to generate time-like showers in ISR | |
1283 | PARMDL(94) = 2.D0 | |
1284 | C factor to scale the max. allowed time-like parton shower virtuality | |
1285 | PARMDL(95) = 4.D0 | |
1286 | C max. transverse momentum for primordial kt | |
1287 | PARMDL(100) = 2.D0 | |
1288 | C weight factors for pt-distribution | |
1289 | PARMDL(101) = 2.D0 | |
1290 | PARMDL(102) = 2.D0 | |
1291 | PARMDL(103) = 4.D0 | |
1292 | PARMDL(104) = 2.D0 | |
1293 | PARMDL(105) = 6.D0 | |
1294 | PARMDL(106) = 4.D0 | |
1295 | C | |
1296 | * PARMDL(110-125) reserved for hard scattering | |
1297 | C currently chosen scales for hard scattering | |
1298 | DO 10 I=1,16 | |
1299 | PARMDL(109+I) = 0.D0 | |
1300 | 10 CONTINUE | |
1301 | C virtuality cutoff in initial state evolution | |
1302 | PARMDL(126) = PARMDL(36)**2 | |
1303 | PARMDL(127) = PARMDL(37)**2 | |
1304 | PARMDL(128) = PARMDL(38)**2 | |
1305 | PARMDL(129) = PARMDL(39)**2 | |
1306 | C virtuality cutoff for direct contribution to photon PDF | |
1307 | PARMDL(130) = 1.D30 | |
1308 | PARMDL(131) = 1.D30 | |
1309 | PARMDL(132) = 1.D30 | |
1310 | PARMDL(133) = 1.D30 | |
1311 | C fraction of events without popcorn | |
1312 | PARMDL(134) = -1.D0 | |
1313 | C fraction of diquarks with spin 1 (relative to sum of spin 1 and 0) | |
1314 | PARMDL(135) = 0.5D0 | |
1315 | C soft color re-connection (fraction) | |
1316 | C g g final state | |
1317 | PARMDL(140) = 1.D0/64.D0 | |
1318 | C g q final state | |
1319 | PARMDL(141) = 1.D0/24.D0 | |
1320 | C q q final state | |
1321 | PARMDL(142) = 1.D0/9.D0 | |
1322 | C effective scale in Drees-Godbole like suppresion in photon PDF | |
1323 | PARMDL(144) = 0.766D0**2 | |
1324 | C QCD scales (if PDF scales are not used, 4 active flavours) | |
1325 | PARMDL(145) = 0.2D0**2 | |
1326 | PARMDL(146) = 0.2D0**2 | |
1327 | PARMDL(147) = 0.2D0**2 | |
1328 | C threshold scales for variable flavour calculation (GeV**2) | |
1329 | PARMDL(148) = 1.5D0**2 | |
1330 | PARMDL(149) = 4.5D0**2 | |
1331 | PARMDL(150) = 175.D0**2 | |
1332 | C constituent quark masses | |
1333 | PARMDL(151) = 0.3D0 | |
1334 | PARMDL(152) = 0.3D0 | |
1335 | PARMDL(153) = 0.5D0 | |
1336 | PARMDL(154) = 1.6D0 | |
1337 | PARMDL(155) = 5.D0 | |
1338 | PARMDL(156) = 174.D0 | |
1339 | C min. masses of valence quark | |
1340 | PARMDL(157) = 0.3D0 | |
1341 | C min. masses of valence diquark | |
1342 | PARMDL(158) = 0.8D0 | |
1343 | C min. mass of sea quark | |
1344 | PARMDL(159) = 0.D0 | |
1345 | C suppression of strange quarks as photon valences | |
1346 | PARMDL(160) = 0.2D0 | |
1347 | C min. masses for strings (used in PHO_SOFTXX) | |
1348 | PARMDL(161) = 1.D0 | |
1349 | PARMDL(162) = 1.D0 | |
1350 | PARMDL(163) = 1.D0 | |
1351 | PARMDL(164) = 1.D0 | |
1352 | C min. momentum fraction for soft processes | |
1353 | PARMDL(165) = 0.3D0 | |
1354 | C min. phase space for x-sampling | |
1355 | PARMDL(166) = 0.135D0 | |
1356 | C Ross-Stodolsky exponent | |
1357 | PARMDL(170) = 4.2D0 | |
1358 | C cutoff on photon-pomeron invariant mass in hadron-hadron collisions | |
1359 | PARMDL(175) = 2.D0 | |
1360 | **sr | |
1361 | * extra factor multiplying difference between Goulianos and PHOJET- | |
1362 | * diff. cross sections | |
1363 | PARMDL(200) = 0.6D0 | |
1364 | ** | |
1365 | C complex amplitudes, eikonal functions | |
1366 | IPAMDL(1) = 0 | |
1367 | C allow for Reggeon cuts | |
1368 | IPAMDL(2) = 1 | |
1369 | C decay of hadron resonances in diffraction (0 iso, 1 trans, 2 long) | |
1370 | IPAMDL(3) = 0 | |
1371 | C polarization of photon resonances (0 none, 1 trans, 2 long) | |
1372 | IPAMDL(4) = 1 | |
1373 | C pt of valence partons | |
1374 | IPAMDL(5) = 1 | |
1375 | C pt of hard scattering remnant | |
1376 | IPAMDL(6) = 2 | |
1377 | C running cutoff for hard scattering | |
1378 | IPAMDL(7) = 1 | |
1379 | C intercept used for the calculation of enhanced graphs | |
1380 | IPAMDL(8) = 1 | |
1381 | C effective slope of hard scattering amplitde | |
1382 | IPAMDL(9) = 1 | |
1383 | C mass dependence of slope parameters | |
1384 | IPAMDL(10) = 0 | |
1385 | C lepton-photon vertex 1 | |
1386 | IPAMDL(11) = 0 | |
1387 | C lepton-photon vertex 2 | |
1388 | IPAMDL(12) = 0 | |
1389 | C call by DPMJET | |
1390 | IPAMDL(13) = 0 | |
1391 | C method to sample x distributions | |
1392 | IPAMDL(14) = 3 | |
1393 | C energy-momentum check | |
1394 | IPAMDL(15) = 1 | |
1395 | C phase space correction for DPMJET interface | |
1396 | IPAMDL(16) = 1 | |
1397 | C fragment strings from projectile/target/central diff. separately | |
1398 | IPAMDL(17) = 1 | |
1399 | C method to construct strings for hard interactions | |
1400 | IPAMDL(18) = 1 | |
1401 | C method to construct strings for soft sea (pomeron cuts) | |
1402 | IPAMDL(19) = 0 | |
1403 | C method to construct strings in pomeron interactions | |
1404 | IPAMDL(20) = 0 | |
1405 | C soft color re-connection | |
1406 | IPAMDL(21) = 0 | |
1407 | C resummation of triple- and loop-Pomeron | |
1408 | IPAMDL(24) = 1 | |
1409 | C resummation of X iterated triple-Pomeron | |
1410 | IPAMDL(25) = 1 | |
1411 | C dimension of interpolation table for weights in hard scattering | |
1412 | IPAMDL(30) = Max_tab_E | |
1413 | C dimension of interpolation table for pomeron cut distribution | |
1414 | IPAMDL(31) = IEETA1 | |
1415 | C number of cut soft pomerons (restriction by field dimension) | |
1416 | IPAMDL(32) = IIMAX | |
1417 | C number of cut hard pomerons (restriction by field dimension) | |
1418 | IPAMDL(33) = KKMAX | |
1419 | C tau pair production in direct photon-photon collisions | |
1420 | IPAMDL(64) = 0 | |
1421 | C currently chosen scales for hard scattering | |
1422 | C ATTENTION: IPAMDL(65-80) reserved for hard scattering! | |
1423 | DO 15 I=1,16 | |
1424 | IPAMDL(64+I) = -99999 | |
1425 | 15 CONTINUE | |
1426 | C scales to calculate alpha-s of matrix element | |
1427 | IPAMDL(81) = 1 | |
1428 | IPAMDL(82) = 1 | |
1429 | IPAMDL(83) = 1 | |
1430 | C scales to calculate alpha-s of initial state radiation | |
1431 | IPAMDL(84) = 1 | |
1432 | IPAMDL(85) = 1 | |
1433 | IPAMDL(86) = 1 | |
1434 | C scales to calculate alpha-s of final state radiation | |
1435 | IPAMDL(87) = 1 | |
1436 | IPAMDL(88) = 1 | |
1437 | IPAMDL(89) = 1 | |
1438 | C scales to calculate PDFs | |
1439 | IPAMDL(90) = 1 | |
1440 | IPAMDL(91) = 1 | |
1441 | IPAMDL(92) = 1 | |
1442 | C where to get the parameter sets from | |
1443 | IPAMDL(99) = 1 | |
1444 | C program PHO_ABORT for fatal errors (simulation of division by zero) | |
1445 | IPAMDL(100) = 0 | |
1446 | C initial state parton showers for all / hardest interaction(s) | |
1447 | IPAMDL(101) = 1 | |
1448 | C final state parton showers for all / hardest interaction(s) | |
1449 | IPAMDL(102) = 1 | |
1450 | C initial virtuality for ISR generation | |
1451 | IPAMDL(109) = 1 | |
1452 | C qqbar-gamma coupling in initial state showers | |
1453 | IPAMDL(110) = 1 | |
1454 | C generation of time-like showers during ISR | |
1455 | IPAMDL(111) = 1 | |
1456 | C reweighting of multiple soft contributions for virtual photons | |
1457 | IPAMDL(114) = 1 | |
1458 | C reweighting / use photon virtuality in photon PDF calculations | |
1459 | IPAMDL(115) = 0 | |
1460 | C use full QPM model incl. interference terms (direct part in gam-gam) | |
1461 | IPAMDL(116) = 0 | |
1462 | C matching sigma_tot to F2 as given by parton density at high Q2 | |
1463 | IPAMDL(117) = 1 | |
1464 | C use virtuality of target in F2 calculations (two-gamma only) | |
1465 | IPAMDL(118) = 1 | |
1466 | C calculation of alpha_em | |
1467 | IPAMDL(120) = 1 | |
1468 | C strict pt cutoff for gamma-gamma events | |
1469 | IPAMDL(121) = 0 | |
1470 | C photon virtuality sampled in photon flux approximations | |
1471 | IPAMDL(174) = 1 | |
1472 | C photon-pomeron: 0,1,2: both,left,right photon emission | |
1473 | IPAMDL(175) = 0 | |
1474 | C keep full history information in PHOJET-JETSET interface | |
1475 | IPAMDL(178) = 1 | |
1476 | C max. number of conservation law violations allowed in one run | |
1477 | IPAMDL(179) = 20 | |
1478 | C selection of soft X values | |
1479 | C max. iteration number in PHO_SELSXS | |
1480 | IPAMDL(180) = 50 | |
1481 | C max. iteration number in PHO_SELSXR | |
1482 | IPAMDL(181) = 200 | |
1483 | C max. iteration number in PHO_SELSX2 | |
1484 | IPAMDL(182) = 100 | |
1485 | C max. iteration number in PHO_SELSXI | |
1486 | IPAMDL(183) = 50 | |
1487 | ||
1488 | C initialize /PROBAB/ | |
1489 | IEEMAX = IEETA1 | |
1490 | IMAX = IIMAX | |
1491 | KMAX = KKMAX | |
1492 | ||
1493 | DO 20 I=1,30 | |
1494 | PARMDL(300+I) = -100000.D0 | |
1495 | 20 CONTINUE | |
1496 | C initialize /POHDRN/ | |
1497 | QMASS(1) = PARMDL(151) | |
1498 | QMASS(2) = PARMDL(152) | |
1499 | QMASS(3) = PARMDL(153) | |
1500 | QMASS(4) = PARMDL(154) | |
1501 | QMASS(5) = PARMDL(155) | |
1502 | QMASS(6) = PARMDL(156) | |
1503 | BET = 8.D0 | |
1504 | PCOUDI = 0.D0 | |
1505 | VALPRG(1) = 1.D0 | |
1506 | VALPRG(2) = 1.D0 | |
1507 | C number of light flavours (quarks treated as massless) | |
1508 | NFS = 4 | |
1509 | C initialize /POCUT1/ | |
1510 | PTCUT(1) = PARMDL(36) | |
1511 | PTCUT(2) = PARMDL(37) | |
1512 | PTCUT(3) = PARMDL(38) | |
1513 | PTCUT(4) = PARMDL(39) | |
1514 | PSOMIN = 0.D0 | |
1515 | XSOMIN = 0.D0 | |
1516 | C initialize /POHAPA/ | |
1517 | NFbeta = 4 | |
1518 | NF = 4 | |
1519 | BQCD(1) = PI4/(11.D0-(2.D0/3.D0)*3) | |
1520 | BQCD(2) = PI4/(11.D0-(2.D0/3.D0)*4) | |
1521 | BQCD(3) = PI4/(11.D0-(2.D0/3.D0)*5) | |
1522 | BQCD(4) = PI4/(11.D0-(2.D0/3.D0)*6) | |
1523 | C initialize /POGAUP/ | |
1524 | NGAUP1 = 12 | |
1525 | NGAUP2 = 12 | |
1526 | NGAUET = 16 | |
1527 | NGAUIN = 12 | |
1528 | NGAUSO = 96 | |
1529 | C initialize // | |
1530 | DO 30 I=1,100 | |
1531 | IDEB(I) = 0 | |
1532 | 30 CONTINUE | |
1533 | C initialize /PROCES/ | |
1534 | DO 35 I=1,11 | |
1535 | IPRON(I,1) = 1 | |
1536 | 35 CONTINUE | |
1537 | C DPMJET default: no elastic scattering | |
1538 | IPRON(2,1) = 0 | |
1539 | DO 36 K=2,4 | |
1540 | DO 37 I=2,11 | |
1541 | IPRON(I,K) = 0 | |
1542 | 37 CONTINUE | |
1543 | IPRON(1,K) = 1 | |
1544 | IPRON(8,K) = 1 | |
1545 | 36 CONTINUE | |
1546 | C initialize /POSVDM/ | |
1547 | TWOPIM = 0.28D0 | |
1548 | RMIN(1) = 0.285D0 | |
1549 | RMIN(2) = 0.45D0 | |
1550 | RMIN(3) = 1.D0 | |
1551 | RMIN(4) = TWOPIM | |
1552 | VMAS(1) = 0.770D0 | |
1553 | VMAS(2) = 0.787D0 | |
1554 | VMAS(3) = 1.02D0 | |
1555 | VMAS(4) = TWOPIM | |
1556 | GAMM(1) = 0.155D0 | |
1557 | GAMM(2) = 0.01D0 | |
1558 | GAMM(3) = 0.0045D0 | |
1559 | GAMM(4) = 1.D0 | |
1560 | RMAX(1) = VMAS(1)+TWOPIM | |
1561 | RMAX(2) = VMAS(2)+TWOPIM | |
1562 | RMAX(3) = VMAS(3)+TWOPIM | |
1563 | RMAX(4) = VMAS(1)+TWOPIM | |
1564 | VMSL(1) = 11.D0 | |
1565 | VMSL(2) = 10.D0 | |
1566 | VMSL(3) = 6.D0 | |
1567 | VMSL(4) = 4.D0 | |
1568 | VMFA(1) = 0.0033D0 | |
1569 | VMFA(2) = 0.00036D0 | |
1570 | VMFA(3) = 0.0002D0 | |
1571 | VMFA(4) = 0.0002D0 | |
1572 | C initialize /PODGL1/ | |
1573 | Q2MISR(1) = PARMDL(36)**2 | |
1574 | Q2MISR(2) = PARMDL(36)**2 | |
1575 | PMISR(1) = 1.D0 | |
1576 | PMISR(2) = 1.D0 | |
1577 | ZMISR(1) = 0.001D0 | |
1578 | ZMISR(2) = 0.001D0 | |
1579 | AL2ISR(1) = 0.046D0 | |
1580 | AL2ISR(2) = 0.046D0 | |
1581 | NFSISR = 4 | |
1582 | C initialize /POPISR/ | |
1583 | DO 40 I=1,50 | |
1584 | IPOISR(1,2,I) = 0 | |
1585 | IPOISR(2,2,I) = 0 | |
1586 | 40 CONTINUE | |
1587 | C initialize /POHPRO/ | |
1588 | PROC(0) = 'sum over processes' | |
1589 | PROC(1) = 'G +G --> G +G ' | |
1590 | PROC(2) = 'Q +QB --> G +G ' | |
1591 | PROC(3) = 'G +Q --> G +Q ' | |
1592 | PROC(4) = 'G +G --> Q +QB ' | |
1593 | PROC(5) = 'Q +QB --> Q +QB ' | |
1594 | PROC(6) = 'Q +QB --> QP +QBP' | |
1595 | PROC(7) = 'Q +Q --> Q +Q ' | |
1596 | PROC(8) = 'Q +QP --> Q +QP ' | |
1597 | PROC(9) = 'resolved processes' | |
1598 | PROC(10) = 'gam+Q --> G +Q ' | |
1599 | PROC(11) = 'gam+G --> Q +QB ' | |
1600 | PROC(12) = 'Q +gam--> G +Q ' | |
1601 | PROC(13) = 'G +gam--> Q +QB ' | |
1602 | PROC(14) = 'gam+gam--> Q +QB ' | |
1603 | PROC(15) = 'direct processes ' | |
1604 | PROC(16) = 'gam+gam--> l+ +l- ' | |
1605 | ||
1606 | C initialize /POHRCS/ | |
1607 | do M=1,Max_pro_2 | |
1608 | HWgx(M) = 0.D0 | |
1609 | HSig(M) = 0.D0 | |
1610 | Hdpt(M) = 0.D0 | |
1611 | enddo | |
1612 | DO I=0,4 | |
1613 | DO M=-1,Max_pro_2 | |
1614 | C switch all hard subprocesses on | |
1615 | MH_pro_on(M,I) = 1 | |
1616 | C reset all counters | |
1617 | MH_tried(M,I) = 0 | |
1618 | MH_acc_1(M,I) = 0 | |
1619 | MH_acc_2(M,I) = 0 | |
1620 | ENDDO | |
1621 | MH_pro_on(16,I) = 0 | |
1622 | ENDDO | |
1623 | ||
1624 | C initialize /POHTAB/ | |
1625 | do I=0,4 | |
1626 | IH_Ecm_up(I) = 0 | |
1627 | IH_Q2a_up(I) = 0 | |
1628 | IH_Q2b_up(I) = 0 | |
1629 | HEcm_tab(1,I) = 0.D0 | |
1630 | enddo | |
1631 | HEcm_last = 0.D0 | |
1632 | IHa_last = 0.D0 | |
1633 | IHb_last = 0.D0 | |
1634 | ||
1635 | C initialize /POFSRC/ | |
1636 | IGHEL(1) = -1 | |
1637 | IGHEL(2) = -1 | |
1638 | C initialize /LEPCUT/ | |
1639 | ECMIN = 5.D0 | |
1640 | ECMAX = 1.D+30 | |
1641 | EEMIN1 = 1.D0 | |
1642 | EEMIN2 = 1.D0 | |
1643 | YMAX1 = -1.D0 | |
1644 | YMAX2 = -1.D0 | |
1645 | THMIN1 = 0.D0 | |
1646 | THMAX1 = PI | |
1647 | THMIN2 = 0.D0 | |
1648 | THMAX2 = PI | |
1649 | ITAG1 = 1 | |
1650 | ITAG2 = 1 | |
1651 | C initialize /POWGHT/ | |
1652 | DO 70 I=1,20 | |
1653 | HSWCUT(I) = 0.D0 | |
1654 | ISWCUT(I) = 0 | |
1655 | 70 CONTINUE | |
1656 | EVWGHT(1) = 1.D0 | |
1657 | IVWGHT(1) = 0 | |
1658 | SIGGEN(1) = 0.D0 | |
1659 | SIGGEN(2) = 0.D0 | |
1660 | SIGGEN(3) = 0.D0 | |
1661 | SIGGEN(4) = 0.D0 | |
1662 | ||
1663 | END | |
1664 | ||
1665 | *$ CREATE PHO_PARDAT.FOR | |
1666 | *COPY PHO_PARDAT | |
1667 | CDECK ID>, PHO_PARDAT | |
1668 | SUBROUTINE PHO_PARDAT | |
1669 | C*********************************************************************** | |
1670 | C | |
1671 | C particle data (based on 1996 PDG naming scheme and data tables) | |
1672 | C | |
1673 | C*********************************************************************** | |
1674 | IMPLICIT NONE | |
1675 | SAVE | |
1676 | ||
1677 | C input/output channels | |
1678 | INTEGER LI,LO | |
1679 | COMMON /POINOU/ LI,LO | |
1680 | C event debugging information | |
1681 | INTEGER NMAXD | |
1682 | PARAMETER (NMAXD=100) | |
1683 | INTEGER IDEB,KSPOM,KHPOM,KSREG,KHDIR,KACCEP,KSTRG,KHTRG,KSLOO, | |
1684 | & KHLOO,KSDPO,KHDPO,KEVENT,KSOFT,KHARD | |
1685 | COMMON /PODEBG/ IDEB(NMAXD),KSPOM,KHPOM,KSREG,KHDIR,KACCEP,KSTRG, | |
1686 | & KHTRG,KSLOO,KHLOO,KSDPO,KHDPO,KEVENT,KSOFT,KHARD | |
1687 | C particle ID translation table | |
1688 | integer ID_pdg_list,ID_list,ID_pdg_max | |
1689 | character*12 name_list | |
1690 | COMMON /POPAR1/ ID_pdg_list(300),ID_list(577),name_list(300), | |
1691 | & ID_pdg_max | |
1692 | C general particle data | |
1693 | double precision xm_list,tau_list,gam_list, | |
1694 | & xm_psm2_list,xm_vem2_list,xm_b82_list,xm_b102_list, | |
1695 | & xm_bb82_list,xm_bb102_list | |
1696 | integer ich3_list,iba3_list,iq_list, | |
1697 | & id_psm_list,id_vem_list,id_b8_list,id_b10_list | |
1698 | COMMON /POPAR2/ xm_list(300),tau_list(300),gam_list(300), | |
1699 | & xm_psm2_list(6,6),xm_vem2_list(6,6), | |
1700 | & xm_b82_list(6,6,6),xm_b102_list(6,6,6), | |
1701 | & xm_bb82_list(6,6,6,6),xm_bb102_list(6,6,6,6), | |
1702 | & ich3_list(300),iba3_list(300),iq_list(3,300), | |
1703 | & id_psm_list(6,6),id_vem_list(6,6), | |
1704 | & id_b8_list(6,6,6),id_b10_list(6,6,6) | |
1705 | C particle decay data | |
1706 | double precision wg_sec_list | |
1707 | integer idec_list,isec_list | |
1708 | COMMON /POPAR3/ wg_sec_list(500),idec_list(3,300), | |
1709 | & isec_list(3,500) | |
1710 | ||
1711 | C external functions | |
1712 | ||
1713 | integer ipho_pdg2id | |
1714 | double precision pho_pmass | |
1715 | ||
1716 | C local variables for storing data tables | |
1717 | ||
1718 | integer number,ich3,iba3,iq_linear,idec_linear,isec_linear, | |
1719 | & id_psm_linear,id_vem_linear,id_b8_linear,id_b10_linear | |
1720 | ||
1721 | dimension number(300),ich3(300),iba3(300),iq_linear(900), | |
1722 | & idec_linear(900),isec_linear(900),id_psm_linear(36), | |
1723 | & id_vem_linear(36),id_b8_linear(216),id_b10_linear(216) | |
1724 | ||
1725 | double precision xmass,gamma,wg_chan | |
1726 | dimension xmass(300),gamma(300),wg_chan(300) | |
1727 | ||
1728 | character*12 name | |
1729 | dimension name(300) | |
1730 | ||
1731 | integer i,i1,i2,ii,j,jj,k,l,ichan,i_tab_max,K8,K10,L8,L10 | |
1732 | double precision AM1,AM2,AM2P,AM2V,AM82,AM102,AMM | |
1733 | integer itmp | |
1734 | ||
1735 | DATA i_tab_max /260/ | |
1736 | ||
1737 | DATA (number(K),K= 1, 171) / | |
1738 | & 1, 2, 3, 4, 5, 6, 1103, 2101, 2103, | |
1739 | & 2203, 3101, 3103, 3201, 3203, 3303, 4101, 4103, 4201, | |
1740 | & 4203, 4301, 4303, 4403, 81, 82, 90, 91, 92, | |
1741 | & 110, 990, 21, 22, 24, 23, 11, 13, 15, | |
1742 | & 12, 14, 16, 211, 111, 221, 113, 213, 223, | |
1743 | & 331, 10221, 10111, 10211, 333, 10223, 10113, 10213, 20113, | |
1744 | & 20213, 225, 20223, 20221, 20111, 20211, 115, 215, 30223, | |
1745 | & 50223, 40113, 40213, 50221, 335, 60223, 227, 10115, 10215, | |
1746 | & 10333, 117, 217, 30113, 30213, 60221, 337, 20225, 229, | |
1747 | & 30225, 40225, 321, 311, 310, 130, 323, 313, 10313, | |
1748 | & 10323, 20313, 20323, 30313, 30323, 10311, 10321, 325, 315, | |
1749 | & 40313, 40323, 10315, 10325, 317, 327, 20315, 20325, 319, | |
1750 | & 329, 411, 421, 423, 413, 10423, 425, 415, 431, | |
1751 | & 433, 10433, 521, 511, 513, 523, 531, 441, 443, | |
1752 | & 10441, 10443, 445, 20443, 30443, 40443, 50443, 60443, 553, | |
1753 | & 551, 10553, 555, 20553, 10551, 70553, 10555, 30553, 40553, | |
1754 | & 50553, 60553, 2212, 2112, 12112, 12212, 1214, 2124, 22112, | |
1755 | & 22212, 32112, 32212, 2116, 2216, 12116, 12216, 21214, 22124, | |
1756 | & 42112, 42212, 31214, 32124, 1218, 2128, 1114, 2114, 2214/ | |
1757 | DATA (number(K),K= 172, 260) / | |
1758 | & 2224, 31114, 32114, 32214, 32224, 1112, 1212, 2122, 2222, | |
1759 | & 11114, 12114, 12214, 12224, 1116, 1216, 2126, 2226, 21112, | |
1760 | & 21212, 22122, 22222, 21114, 22114, 22214, 22224, 11116, 11216, | |
1761 | & 12126, 12226, 1118, 2118, 2218, 2228, 3122, 13122, 3124, | |
1762 | & 23122, 33122, 13124, 43122, 53122, 3126, 13126, 23124, 3128, | |
1763 | & 23126, 3222, 3212, 3112, 3224, 3214, 3114, 13112, 13212, | |
1764 | & 13222, 13114, 13214, 13224, 23112, 23212, 23222, 3116, 3216, | |
1765 | & 3226, 13116, 13216, 13226, 23114, 23214, 23224, 3118, 3218, | |
1766 | & 3228, 3322, 3312, 3324, 3314, 13314, 13324, 3334, 4122, | |
1767 | & 14122, 4222, 4212, 4112, 4232, 4132, 4332, 5122/ | |
1768 | DATA (name(K),K= 1, 76) / | |
1769 | &'d ','u ','s ','c ', | |
1770 | &'b ','t ','(dd)_1 ','(ud)_0 ', | |
1771 | &'(ud)_1 ','(uu)_1 ','(sd)_0 ','(sd)_1 ', | |
1772 | &'(su)_0 ','(su)_1 ','(ss)_1 ','(cd)_0 ', | |
1773 | &'(cd)_1 ','(cu)_0 ','(cu)_1 ','(cs)_0 ', | |
1774 | &'(cs)_1 ','(cc)_1 ','remnant 1 ','remnant 2 ', | |
1775 | &'string ','mod. string ','coll. string','reggeon ', | |
1776 | &'pomeron ','gluon ','gamma ','W ', | |
1777 | &'Z ','e ','mu ','tau ', | |
1778 | &'nu(e) ','nu(mu) ','nu(tau) ','pi ', | |
1779 | &'pi ','eta ','rho(770) ','rho(770) ', | |
1780 | &'ome(782) ','etap(958) ','f(0)(980) ','a(0)(980) ', | |
1781 | &'a(0)(980) ','phi(1020) ','h(1)(1170) ','b(1)(1235) ', | |
1782 | &'b(1)(1235) ','a(1)(1260) ','a(1)(1260) ','f(2)(1270) ', | |
1783 | &'f(1)(1285) ','eta(1295) ','pi(1300) ','pi(1300) ', | |
1784 | &'a(2)(1320) ','a(2)(1320) ','f(1)(1420) ','ome(1420) ', | |
1785 | &'rho(1450) ','rho(1450) ','f(0)(1500) ','f(2)p(1525) ', | |
1786 | &'ome(1600) ','ome(3)(1670)','pi(2)(1670) ','pi(2)(1670) ', | |
1787 | &'phi(1680) ','rho(3)(1690)','rho(3)(1690)','rho(1700) '/ | |
1788 | DATA (name(K),K= 77, 152) / | |
1789 | &'rho(1700) ','f(J)(1710) ','phi(3)(1850)','f(2)(2010) ', | |
1790 | &'f(4)(2050) ','f(2)(2300) ','f(2)(2340) ','K ', | |
1791 | &'K ','K(S) ','K(L) ','K*(892) ', | |
1792 | &'K*(892) ','K(1)(1270) ','K(1)(1270) ','K(1)(1400) ', | |
1793 | &'K(1)(1400) ','K*(1410) ','K*(1410) ','K(0)*(1430) ', | |
1794 | &'K(0)*(1430) ','K(2)*(1430) ','K(2)*(1430) ','K*(1680) ', | |
1795 | &'K*(1680) ','K(2)(1770) ','K(2)(1770) ','K(3)*(1780) ', | |
1796 | &'K(3)*(1780) ','K(2)(1820) ','K(2)(1820) ','K(4)*(2045) ', | |
1797 | &'K(4)*(2045) ','D ','D ','D*(2007) ', | |
1798 | &'D*(2010) ','D(1)(2420) ','D(2)*(2460) ','D(2)*(2460) ', | |
1799 | &'D(s) ','D(s)* ','D(s1)(2536) ','B ', | |
1800 | &'B ','B* ','B* ','B(s) ', | |
1801 | &'eta(c)(1S) ','J/psi(1S) ','chi(c0)(1P) ','chi(c1)(1P) ', | |
1802 | &'chi(c2)(1P) ','psi(2S) ','psi(3770) ','psi(4040) ', | |
1803 | &'psi(4160) ','psi(4415) ','Ups(1S) ','chi(b0)(1P) ', | |
1804 | &'chi(b1)(1P) ','chi(b2)(1P) ','Ups(2S) ','chi(b0)(2P) ', | |
1805 | &'chi(b1)(2P) ','chi(b2)(2P) ','Ups(3S) ','Ups(4S) ', | |
1806 | &'Ups(10860) ','Ups(11020) ','p ','n ', | |
1807 | &'N(1440) ','N(1440) ','N(1520) ','N(1520) '/ | |
1808 | DATA (name(K),K= 153, 228) / | |
1809 | &'N(1535) ','N(1535) ','N(1650) ','N(1650) ', | |
1810 | &'N(1675) ','N(1675) ','N(1680) ','N(1680) ', | |
1811 | &'N(1700) ','N(1700) ','N(1710) ','N(1710) ', | |
1812 | &'N(1720) ','N(1720) ','N(2190) ','N(2190) ', | |
1813 | &'Del(1232) ','Del(1232) ','Del(1232) ','Del(1232) ', | |
1814 | &'Del(1600) ','Del(1600) ','Del(1600) ','Del(1600) ', | |
1815 | &'Del(1620) ','Del(1620) ','Del(1620) ','Del(1620) ', | |
1816 | &'Del(1700) ','Del(1700) ','Del(1700) ','Del(1700) ', | |
1817 | &'Del(1905) ','Del(1905) ','Del(1905) ','Del(1905) ', | |
1818 | &'Del(1910) ','Del(1910) ','Del(1910) ','Del(1910) ', | |
1819 | &'Del(1920) ','Del(1920) ','Del(1920) ','Del(1920) ', | |
1820 | &'Del(1930) ','Del(1930) ','Del(1930) ','Del(1930) ', | |
1821 | &'Del(1950) ','Del(1950) ','Del(1950) ','Del(1950) ', | |
1822 | &'Lambda ','Lam(1405) ','Lam(1520) ','Lam(1600) ', | |
1823 | &'Lam(1670) ','Lam(1690) ','Lam(1800) ','Lam(1810) ', | |
1824 | &'Lam(1820) ','Lam(1830) ','Lam(1890) ','Lam(2100) ', | |
1825 | &'Lam(2110) ','Sigma ','Sigma ','Sigma ', | |
1826 | &'Sig(1385) ','Sig(1385) ','Sig(1385) ','Sig(1660) ', | |
1827 | &'Sig(1660) ','Sig(1660) ','Sig(1670) ','Sig(1670) '/ | |
1828 | DATA (name(K),K= 229, 260) / | |
1829 | &'Sig(1670) ','Sig(1750) ','Sig(1750) ','Sig(1750) ', | |
1830 | &'Sig(1775) ','Sig(1775) ','Sig(1775) ','Sig(1915) ', | |
1831 | &'Sig(1915) ','Sig(1915) ','Sig(1940) ','Sig(1940) ', | |
1832 | &'Sig(1940) ','Sig(2030) ','Sig(2030) ','Sig(2030) ', | |
1833 | &'Xi ','Xi ','Xi(1530) ','Xi(1530) ', | |
1834 | &'Xi(1820) ','Xi(1820) ','Omega ','Lam(c) ', | |
1835 | &'Lam(c)(2593)','Sig(c)(2455)','Sig(c)(2455)','Sig(c)(2455)', | |
1836 | &'Xi(c) ','Xi(c) ','Ome(c) ','Lam(b) '/ | |
1837 | DATA (ich3(K),K= 1, 260) / | |
1838 | &-1, 2,-1, 2,-1, 2,-2, 1, 1, 4,-2,-2, 1, 1,-2, 1, 1, 4, 4, 1, 1, 4, | |
1839 | & 0, 0, 0, 0, 0, 0, 0, 0, 0, 3, 0,-3,-3,-3, 0, 0, 0, 3, 0, 0, 0, 3, | |
1840 | & 0, 0, 0, 0, 3, 0, 0, 0, 3, 0, 3, 0, 0, 0, 0, 3, 0, 3, 0, 0, 0, 3, | |
1841 | & 0, 0, 0, 0, 0, 3, 0, 0, 3, 0, 3, 0, 0, 0, 0, 0, 0, 3, 0, 0, 0, 3, | |
1842 | & 0, 0, 3, 0, 3, 0, 3, 0, 3, 3, 0, 0, 3, 0, 3, 0, 3, 0, 3, 0, 3, 3, | |
1843 | & 0, 0, 3, 0, 0, 3, 3, 3, 3, 3, 0, 0, 3, 0, 0, 0, 0, 0, 0, 0, 0, 0, | |
1844 | & 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 3, 0, 0, 3, 0, 3, 0, 3, | |
1845 | & 0, 3, 0, 3, 0, 3, 0, 3, 0, 3, 0, 3, 0, 3,-3, 0, 3, 6,-3, 0, 3, 6, | |
1846 | &-3, 0, 3, 6,-3, 0, 3, 6,-3, 0, 3, 6,-3, 0, 3, 6,-3, 0, 3, 6,-3, 0, | |
1847 | & 3, 6,-3, 0, 3, 6, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 3, 0,-3, | |
1848 | & 3, 0,-3,-3, 0, 3,-3, 0, 3,-3, 0, 3,-3, 0, 3,-3, 0, 3,-3, 0, 3,-3, | |
1849 | & 0, 3, 0,-3, 0,-3,-3, 0,-3, 3, 3, 6, 3, 0, 3, 0, 0, 0/ | |
1850 | DATA (iba3(K),K= 1, 260) / | |
1851 | &1,1,1,1,1,1,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,0,0,0,0,0,0,0,0,0,0,0, | |
1852 | &0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, | |
1853 | &0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, | |
1854 | &0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, | |
1855 | &0,0,0,0,0,0,0,0,0,0,0,0,0,0,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3, | |
1856 | &3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3, | |
1857 | &3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3, | |
1858 | &3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3/ | |
1859 | DATA (iq_linear(K),K= 1, 418) / | |
1860 | & 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 1, 0, 2, | |
1861 | & 1, 0, 2, 1, 0, 2, 2, 0, 3, 1, 0, 3, 1, 0, 3, 2, 0, 3, 2, 0, 3, 3, | |
1862 | & 0, 4, 1, 0, 4, 1, 0, 4, 2, 0, 4, 2, 0, 4, 3, 0, 4, 3, 0, 4, 4, 0, | |
1863 | & 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, | |
1864 | & 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, | |
1865 | & 0, 0, 0, 0, 0, 0, 0, 2,-1, 0, 1,-1, 0, 2,-2, 0, 1,-1, 0, 2,-1, 0, | |
1866 | & 2,-2, 0, 3,-3, 0, 2,-2, 0, 1,-1, 0, 2,-1, 0, 3,-3, 0, 2,-2, 0, 1, | |
1867 | &-1, 0, 2,-1, 0, 1,-1, 0, 2, 1, 0, 2,-2, 0, 2,-2, 0, 2,-2, 0, 1,-1, | |
1868 | & 0, 2,-1, 0, 1,-1, 0, 2,-1, 0, 2,-2, 0, 2,-2, 0, 1,-1, 0, 2,-1, 0, | |
1869 | & 2,-2, 0, 3,-3, 0, 2,-2, 0, 2,-2, 0, 1,-1, 0, 2,-1, 0, 3,-3, 0, 1, | |
1870 | &-1, 0, 2,-1, 0, 1,-1, 0, 2,-1, 0, 2,-2, 0, 3,-3, 0, 2,-2, 0, 2,-2, | |
1871 | & 0, 2,-2, 0, 2,-2, 0, 2,-3, 0, 1,-3, 0, 1,-3, 0, 3,-1, 0, 2,-3, 0, | |
1872 | & 1,-3, 0, 1,-3, 0, 2,-3, 0, 1,-3, 0, 2,-3, 0, 1,-3, 0, 2,-3, 0, 1, | |
1873 | &-3, 0, 2,-3, 0, 2,-3, 0, 1,-3, 0, 1,-3, 0, 2,-3, 0, 1,-3, 0, 2,-3, | |
1874 | & 0, 1,-3, 0, 2,-3, 0, 1,-3, 0, 2,-3, 0, 1,-3, 0, 2,-3, 0, 4,-1, 0, | |
1875 | & 4,-2, 0, 4,-2, 0, 4,-1, 0, 4,-2, 0, 4,-2, 0, 4,-1, 0, 4,-3, 0, 4, | |
1876 | &-3, 0, 4,-3, 0, 2,-5, 0, 1,-5, 0, 1,-5, 0, 2,-5, 0, 3,-5, 0, 4,-4, | |
1877 | & 0, 4,-4, 0, 4,-4, 0, 4,-4, 0, 4,-4, 0, 4,-4, 0, 4,-4, 0, 4,-4, 0, | |
1878 | & 4,-4, 0, 4,-4, 0, 5,-5, 0, 5,-5, 0, 5,-5, 0, 5,-5, 0, 5,-5, 0, 5/ | |
1879 | DATA (iq_linear(K),K= 419, 780) / | |
1880 | &-5, 0, 5,-5, 0, 5,-5, 0, 5,-5, 0, 5,-5, 0, 5,-5, 0, 5,-5, 0, 2, 2, | |
1881 | & 1, 2, 1, 1, 2, 1, 1, 2, 2, 1, 1, 2, 1, 2, 1, 2, 2, 1, 1, 2, 2, 1, | |
1882 | & 2, 1, 1, 2, 2, 1, 2, 2, 2, 2, 2, 1, 2, 1, 1, 2, 2, 1, 1, 2, 1, 2, | |
1883 | & 1, 2, 2, 1, 1, 2, 2, 1, 1, 2, 1, 2, 1, 2, 1, 2, 1, 2, 1, 2, 1, 1, | |
1884 | & 1, 2, 1, 1, 2, 2, 1, 2, 2, 2, 1, 1, 1, 2, 1, 1, 2, 2, 1, 2, 2, 2, | |
1885 | & 1, 1, 1, 1, 2, 1, 2, 1, 2, 2, 2, 2, 1, 1, 1, 2, 1, 1, 2, 2, 1, 2, | |
1886 | & 2, 2, 1, 1, 1, 1, 2, 1, 2, 1, 2, 2, 2, 2, 1, 1, 1, 1, 2, 1, 2, 1, | |
1887 | & 2, 2, 2, 2, 1, 1, 1, 2, 1, 1, 2, 1, 1, 2, 2, 2, 1, 1, 1, 1, 2, 1, | |
1888 | & 2, 1, 2, 2, 2, 2, 1, 1, 1, 2, 1, 1, 2, 2, 1, 2, 2, 2, 3, 1, 2, 3, | |
1889 | & 1, 2, 3, 1, 2, 3, 1, 2, 3, 1, 2, 3, 1, 2, 3, 1, 2, 3, 1, 2, 3, 1, | |
1890 | & 2, 3, 1, 2, 3, 1, 2, 3, 1, 2, 3, 1, 2, 2, 2, 3, 2, 1, 3, 1, 1, 3, | |
1891 | & 3, 2, 2, 3, 2, 1, 3, 1, 1, 3, 1, 1, 3, 2, 1, 3, 2, 2, 3, 1, 1, 3, | |
1892 | & 2, 1, 3, 2, 2, 3, 1, 1, 3, 2, 1, 3, 2, 2, 3, 1, 1, 3, 2, 1, 3, 2, | |
1893 | & 2, 3, 1, 1, 3, 2, 1, 3, 2, 2, 3, 1, 1, 3, 2, 1, 3, 2, 2, 3, 1, 1, | |
1894 | & 3, 2, 1, 3, 2, 2, 2, 3, 3, 1, 3, 3, 2, 3, 3, 1, 3, 3, 3, 3, 1, 3, | |
1895 | & 3, 2, 3, 3, 3, 2, 1, 4, 4, 1, 2, 2, 2, 4, 2, 1, 2, 1, 1, 4, 3, 2, | |
1896 | & 2, 3, 1, 2, 3, 3, 4, 5, 1, 2/ | |
1897 | DATA (xmass(K),K= 1, 114) / | |
1898 | &3.0000E-01,3.0000E-01,3.5000E-01,1.4500E+00,4.5000E+00,1.7400E+02, | |
1899 | &7.7133E-01,5.7933E-01,7.7133E-01,7.7133E-01,8.0473E-01,9.2953E-01, | |
1900 | &8.0473E-01,9.2953E-01,1.0936E+00,1.9691E+00,2.0081E+00,1.9691E+00, | |
1901 | &2.0081E+00,2.1543E+00,2.1797E+00,3.2753E+00,0.0000E+00,0.0000E+00, | |
1902 | &0.0000E+00,0.0000E+00,0.0000E+00,0.0000E+00,0.0000E+00,0.0000E+00, | |
1903 | &0.0000E+00,8.0410E+01,9.1187E+01,5.1100E-04,1.0566E-01,1.7771E+00, | |
1904 | &0.0000E+00,0.0000E+00,0.0000E+00,1.3957E-01,1.3498E-01,5.4730E-01, | |
1905 | &7.7000E-01,7.7000E-01,7.8194E-01,9.5778E-01,9.8000E-01,9.8340E-01, | |
1906 | &9.8340E-01,1.0194E+00,1.1700E+00,1.2295E+00,1.2295E+00,1.2300E+00, | |
1907 | &1.2300E+00,1.2750E+00,1.2819E+00,1.2970E+00,1.3000E+00,1.3000E+00, | |
1908 | &1.3181E+00,1.3181E+00,1.4262E+00,1.4190E+00,1.4650E+00,1.4650E+00, | |
1909 | &1.5000E+00,1.5250E+00,1.6490E+00,1.6670E+00,1.6700E+00,1.6700E+00, | |
1910 | &1.6800E+00,1.6910E+00,1.6910E+00,1.7000E+00,1.7000E+00,1.7120E+00, | |
1911 | &1.8540E+00,2.0100E+00,2.0440E+00,2.2970E+00,2.3400E+00,4.9368E-01, | |
1912 | &4.9767E-01,4.9767E-01,4.9767E-01,8.9166E-01,8.9610E-01,1.2720E+00, | |
1913 | &1.2720E+00,1.4020E+00,1.4020E+00,1.4140E+00,1.4140E+00,1.4290E+00, | |
1914 | &1.4290E+00,1.4256E+00,1.4324E+00,1.7170E+00,1.7170E+00,1.7730E+00, | |
1915 | &1.7730E+00,1.7760E+00,1.7760E+00,1.8160E+00,1.8160E+00,2.0450E+00, | |
1916 | &2.0450E+00,1.8693E+00,1.8646E+00,2.0067E+00,2.0100E+00,2.4222E+00/ | |
1917 | DATA (xmass(K),K= 115, 228) / | |
1918 | &2.4589E+00,2.4590E+00,1.9685E+00,2.1124E+00,2.5353E+00,5.2789E+00, | |
1919 | &5.2792E+00,5.3249E+00,5.3249E+00,5.3693E+00,2.9798E+00,3.0969E+00, | |
1920 | &3.4173E+00,3.5105E+00,3.5562E+00,3.6860E+00,3.7699E+00,4.0400E+00, | |
1921 | &4.1590E+00,4.4150E+00,9.4604E+00,9.8598E+00,9.8919E+00,9.9132E+00, | |
1922 | &1.0023E+01,1.0232E+01,1.0255E+01,1.0268E+01,1.0355E+01,1.0580E+01, | |
1923 | &1.0865E+01,1.1019E+01,9.3827E-01,9.3957E-01,1.4400E+00,1.4400E+00, | |
1924 | &1.5200E+00,1.5200E+00,1.5350E+00,1.5350E+00,1.6500E+00,1.6500E+00, | |
1925 | &1.6750E+00,1.6750E+00,1.6800E+00,1.6800E+00,1.7000E+00,1.7000E+00, | |
1926 | &1.7100E+00,1.7100E+00,1.7200E+00,1.7200E+00,2.1900E+00,2.1900E+00, | |
1927 | &1.2320E+00,1.2320E+00,1.2320E+00,1.2320E+00,1.6000E+00,1.6000E+00, | |
1928 | &1.6000E+00,1.6000E+00,1.6200E+00,1.6200E+00,1.6200E+00,1.6200E+00, | |
1929 | &1.7000E+00,1.7000E+00,1.7000E+00,1.7000E+00,1.9050E+00,1.9050E+00, | |
1930 | &1.9050E+00,1.9050E+00,1.9100E+00,1.9100E+00,1.9100E+00,1.9100E+00, | |
1931 | &1.9200E+00,1.9200E+00,1.9200E+00,1.9200E+00,1.9300E+00,1.9300E+00, | |
1932 | &1.9300E+00,1.9300E+00,1.9500E+00,1.9500E+00,1.9500E+00,1.9500E+00, | |
1933 | &1.1157E+00,1.4070E+00,1.5195E+00,1.6000E+00,1.6700E+00,1.6900E+00, | |
1934 | &1.8000E+00,1.8100E+00,1.8200E+00,1.8300E+00,1.8900E+00,2.1000E+00, | |
1935 | &2.1100E+00,1.1894E+00,1.1926E+00,1.1974E+00,1.3828E+00,1.3837E+00, | |
1936 | &1.3872E+00,1.6600E+00,1.6600E+00,1.6600E+00,1.6700E+00,1.6700E+00/ | |
1937 | DATA (xmass(K),K= 229, 260) / | |
1938 | &1.6700E+00,1.7500E+00,1.7500E+00,1.7500E+00,1.7750E+00,1.7750E+00, | |
1939 | &1.7750E+00,1.9150E+00,1.9150E+00,1.9150E+00,1.9400E+00,1.9400E+00, | |
1940 | &1.9400E+00,2.0300E+00,2.0300E+00,2.0300E+00,1.3149E+00,1.3213E+00, | |
1941 | &1.5318E+00,1.5350E+00,1.8230E+00,1.8230E+00,1.6724E+00,2.2849E+00, | |
1942 | &2.5939E+00,2.4528E+00,2.4536E+00,2.4522E+00,2.4656E+00,2.4703E+00, | |
1943 | &2.7040E+00,5.6240E+00/ | |
1944 | DATA (gamma(K),K= 1, 114) / | |
1945 | &8.0000E-01,8.0000E-01,8.0000E-01,8.0000E-01,8.0000E-01,8.0000E-01, | |
1946 | &8.0000E-01,8.0000E-01,8.0000E-01,8.0000E-01,8.0000E-01,8.0000E-01, | |
1947 | &8.0000E-01,8.0000E-01,8.0000E-01,0.0000E+00,0.0000E+00,0.0000E+00, | |
1948 | &0.0000E+00,0.0000E+00,0.0000E+00,0.0000E+00,0.0000E+00,0.0000E+00, | |
1949 | &0.0000E+00,0.0000E+00,0.0000E+00,0.0000E+00,0.0000E+00,0.0000E+00, | |
1950 | &0.0000E+00,2.0600E+00,2.4900E+00,0.0000E+00,2.9959E-19,2.2700E-12, | |
1951 | &0.0000E+00,0.0000E+00,0.0000E+00,2.5284E-17,7.8000E-09,1.1800E-06, | |
1952 | &1.5070E-01,1.5070E-01,8.4100E-03,2.0300E-04,0.0000E+00,0.0000E+00, | |
1953 | &0.0000E+00,4.4300E-03,3.6000E-01,1.4200E-01,1.4200E-01,0.0000E+00, | |
1954 | &0.0000E+00,1.8550E-01,2.4000E-02,5.3000E-02,0.0000E+00,0.0000E+00, | |
1955 | &1.0700E-01,1.0700E-01,5.5000E-02,1.7000E-01,3.1000E-01,3.1000E-01, | |
1956 | &1.1200E-01,7.6000E-02,2.2000E-01,1.6800E-01,2.5800E-01,2.5800E-01, | |
1957 | &1.5000E-01,1.6000E-01,1.6000E-01,2.4000E-01,2.4000E-01,1.3300E-01, | |
1958 | &8.7000E-02,2.0000E-01,2.0800E-01,1.5000E-01,3.2000E-01,5.3140E-17, | |
1959 | &0.0000E+00,7.3730E-15,1.2730E-17,5.0800E-02,5.0500E-02,9.0000E-02, | |
1960 | &9.0000E-02,1.7400E-01,1.7400E-01,2.3200E-01,2.3200E-01,2.8700E-01, | |
1961 | &2.8700E-01,9.8500E-02,1.0900E-01,3.2000E-01,3.2000E-01,1.8600E-01, | |
1962 | &1.8600E-01,1.5900E-01,1.5900E-01,2.7600E-01,2.7600E-01,1.9800E-01, | |
1963 | &1.9800E-01,6.2300E-13,1.5860E-12,5.0000E-03,2.0000E-03,1.8900E-02/ | |
1964 | DATA (gamma(K),K= 115, 228) / | |
1965 | &2.3000E-02,2.5000E-02,1.4100E-12,2.0000E-03,0.0000E+00,3.9900E-13, | |
1966 | &4.2200E-13,0.0000E+00,0.0000E+00,4.2700E-13,1.3200E-02,8.7000E-05, | |
1967 | &1.4000E-02,8.8000E-04,2.0000E-03,2.7700E-04,2.3600E-02,5.2000E-02, | |
1968 | &7.8000E-02,4.3000E-02,5.2500E-05,0.0000E+00,0.0000E+00,0.0000E+00, | |
1969 | &4.4000E-05,0.0000E+00,0.0000E+00,0.0000E+00,2.6300E-05,1.0000E-02, | |
1970 | &1.1000E-01,7.9000E-02,0.0000E+00,7.4240E-28,3.5000E-01,3.5000E-01, | |
1971 | &1.2000E-01,1.2000E-01,1.5000E-01,1.5000E-01,1.5000E-01,1.5000E-01, | |
1972 | &1.5000E-01,1.5000E-01,1.3000E-01,1.3000E-01,1.0000E-01,1.0000E-01, | |
1973 | &1.0000E-01,1.0000E-01,1.5000E-01,1.5000E-01,4.5000E-01,4.5000E-01, | |
1974 | &1.2000E-01,1.2000E-01,1.2000E-01,1.2000E-01,3.5000E-01,3.5000E-01, | |
1975 | &3.5000E-01,3.5000E-01,1.5000E-01,1.5000E-01,1.5000E-01,1.5000E-01, | |
1976 | &3.0000E-01,3.0000E-01,3.0000E-01,3.0000E-01,3.5000E-01,3.5000E-01, | |
1977 | &3.5000E-01,3.5000E-01,2.5000E-01,2.5000E-01,2.5000E-01,2.5000E-01, | |
1978 | &2.0000E-01,2.0000E-01,2.0000E-01,2.0000E-01,3.5000E-01,3.5000E-01, | |
1979 | &3.5000E-01,3.5000E-01,3.0000E-01,3.0000E-01,3.0000E-01,3.0000E-01, | |
1980 | &2.5010E-15,5.0000E-02,1.5600E-02,1.5000E-01,3.5000E-02,6.0000E-02, | |
1981 | &3.0000E-01,1.5000E-01,8.0000E-02,9.5000E-02,1.0000E-01,2.0000E-01, | |
1982 | &2.0000E-01,8.2400E-15,8.9000E-06,4.4500E-15,3.5800E-02,3.6000E-02, | |
1983 | &3.9400E-02,1.0000E-01,1.0000E-01,1.0000E-01,6.0000E-02,6.0000E-02/ | |
1984 | DATA (gamma(K),K= 229, 260) / | |
1985 | &6.0000E-02,9.0000E-02,9.0000E-02,9.0000E-02,1.2000E-01,1.2000E-01, | |
1986 | &1.2000E-01,1.2000E-01,1.2000E-01,1.2000E-01,2.2000E-01,2.2000E-01, | |
1987 | &2.2000E-01,1.8000E-01,1.8000E-01,1.8000E-01,2.2700E-15,4.0200E-15, | |
1988 | &9.1000E-03,9.9000E-03,2.4000E-02,2.4000E-02,8.0100E-15,3.1900E-12, | |
1989 | &3.6000E-03,0.0000E+00,0.0000E+00,0.0000E+00,1.8600E-12,6.7000E-12, | |
1990 | &1.0200E-11,5.3100E-13/ | |
1991 | DATA (idec_linear(K),K= 1, 304) / | |
1992 | & 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, | |
1993 | & 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, | |
1994 | & 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, | |
1995 | & 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, | |
1996 | & 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, | |
1997 | & 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, | |
1998 | & 0, 0, 0, 0, 0, 0, 3, 1, 1, 2, 2, 6, 0, 0, 0, 0, | |
1999 | & 0, 0, 0, 0, 0, 3, 7, 7, 3, 8, 9, 1, 10, 14, 1, 15, | |
2000 | & 16, 1, 17, 17, 1, 18, 20, 1, 21, 24, 0, 0, 0, 0, 0, 0, | |
2001 | & 0, 0, 0, 1, 25, 29, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, | |
2002 | & 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, | |
2003 | & 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 30, 32, | |
2004 | & 1, 33, 34, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 35, 37, 0, | |
2005 | & 0, 0, 0, 0, 0, 0, 0, 0, 1, 38, 39, 0, 0, 0, 0, 0, | |
2006 | & 0, 1, 40, 40, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, | |
2007 | & 0, 0, 0, 0, 0, 0, 0, 0, 0, 3, 41, 46, 0, 0, 0, 3, | |
2008 | & 47, 48, 3, 49, 52, 1, 53, 54, 1, 55, 56, 1, 57, 58, 1, 59, | |
2009 | & 60, 0, 0, 0, 0, 0, 0, 1, 61, 68, 1, 69, 76, 0, 0, 0, | |
2010 | & 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0/ | |
2011 | DATA (idec_linear(K),K= 305, 608) / | |
2012 | & 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, | |
2013 | & 0, 0, 0, 0, 0, 0, 0, 2, 77, 78, 2, 79, 82, 1, 83, 84, | |
2014 | & 1, 85, 87, 0, 0, 0, 0, 0, 0, 0, 0, 0, 2, 88, 90, 1, | |
2015 | & 91, 92, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, | |
2016 | & 0, 0, 0, 0, 2, 93, 95, 1, 96, 98, 0, 0, 0, 0, 0, 0, | |
2017 | & 0, 0, 0, 1, 99,101, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, | |
2018 | & 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, | |
2019 | & 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, | |
2020 | & 0, 0, 0, 0, 0, 0, 0, 0, 0, 3,102,102, 1,103,112, 1, | |
2021 | &113,122, 0, 0, 0, 0, 0, 0, 1,123,129, 1,130,136, 0, 0, | |
2022 | & 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, | |
2023 | & 0, 0, 0, 0, 0, 0, 1,137,144, 1,145,152, 0, 0, 0, 0, | |
2024 | & 0, 0, 0, 0, 0, 0, 0, 0, 1,153,153, 1,154,155, 1,156, | |
2025 | &157, 1,158,158, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, | |
2026 | & 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1,159,162, 1, | |
2027 | &163,169, 1,170,176, 1,177,180, 0, 0, 0, 0, 0, 0, 0, 0, | |
2028 | & 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, | |
2029 | & 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, | |
2030 | & 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0/ | |
2031 | DATA (idec_linear(K),K= 609, 780) / | |
2032 | & 0, 0, 0, 0, 3,181,182, 0, 0, 0, 0, 0, 0, 0, 0, 0, | |
2033 | & 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, | |
2034 | & 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 3,183,184, 3,185, | |
2035 | &185, 3,186,186, 1,187,189, 1,190,192, 1,193,194, 0, 0, 0, | |
2036 | & 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, | |
2037 | & 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1,195,203, 0, 0, | |
2038 | & 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, | |
2039 | & 0, 0, 0, 0, 0, 0, 1,204,216, 0, 0, 0, 3,217,217, 3, | |
2040 | &218,218, 1,219,220, 1,221,222, 0, 0, 0, 0, 0, 0, 2,223, | |
2041 | &225, 2,226,239, 0, 0, 0, 2,240,240, 2,241,241, 2,242,242, | |
2042 | & 2,243,246, 2,247,251, 2,252,255, 0, 0, 0/ | |
2043 | DATA (isec_linear(K),K= 1, 152) / | |
2044 | & 11, 12, -12, 13, -14, 16, 11, -12, | |
2045 | & 16, -213, 16, 0, -211, 16, 0, -323, | |
2046 | & 16, 0, -13, 12, 0, 22, 22, 0, | |
2047 | & 22, -11, 11, 22, 22, 0, 111, 22, | |
2048 | & 22, 111, 111, 111, 211, -211, 111, 211, | |
2049 | & -211, 22, 211, -211, 0, 111, 111, 0, | |
2050 | & 211, 111, 0, 211, -211, 111, 211, -211, | |
2051 | & 0, 111, 22, 0, 221, 211, -211, 221, | |
2052 | & 111, 111, 211, -211, 22, 22, 22, 0, | |
2053 | & 321, -321, 0, 130, 310, 0, 113, 111, | |
2054 | & 0, 211, -211, 111, 221, 22, 0, 113, | |
2055 | & 111, 0, -213, 211, 0, 213, -211, 0, | |
2056 | & 211, -211, 0, 111, 111, 0, 113, 111, | |
2057 | & 0, -213, 211, 0, 213, -211, 0, 311, | |
2058 | & -313, 0, -311, 313, 0, 113, 211, -211, | |
2059 | & -13, 12, 0, 211, 111, 0, 211, 211, | |
2060 | & -211, 211, 111, 111, -13, 111, 12, -11, | |
2061 | & 111, 12, 211, -211, 0, 111, 111, 0, | |
2062 | & 111, 111, 111, 211, -211, 111, 211, 13/ | |
2063 | DATA (isec_linear(K),K= 153, 304) / | |
2064 | & 12, 211, 11, 12, 321, 111, 0, 311, | |
2065 | & 211, 0, 311, 111, 0, 321, -211, 0, | |
2066 | & 311, 111, 0, 321, -211, 0, 321, 111, | |
2067 | & 0, 311, 211, 0, 311, 111, 0, 321, | |
2068 | & -211, 0, 313, 111, 0, 323, -211, 0, | |
2069 | & 311, 113, 0, 321, -213, 0, 311, 223, | |
2070 | & 0, 311, 221, 0, 321, 111, 0, 311, | |
2071 | & 211, 0, 323, 111, 0, 313, 211, 0, | |
2072 | & 321, 113, 0, 311, 213, 0, 321, 223, | |
2073 | & 0, 321, 221, 0, -321, 211, 211, -311, | |
2074 | & 211, 0, -321, 211, 0, -321, 211, 111, | |
2075 | & 311, 211, -211, 311, 111, 0, 421, 111, | |
2076 | & 0, 421, 22, 0, 421, 211, 0, 411, | |
2077 | & 111, 0, 411, 22, 0, 221, 211, 0, | |
2078 | & 321, -321, 321, 321, -311, 0, 431, 22, | |
2079 | & 0, 431, 22, 0, 111, 111, 0, 211, | |
2080 | & -211, 0, 22, 22, 0, -11, 11, 0, | |
2081 | & -13, 13, 0, 211, -211, 111, 443, 211, | |
2082 | & -211, 443, 111, 111, 443, 221, 0, 2212/ | |
2083 | DATA (isec_linear(K),K= 305, 456) / | |
2084 | & 11, 12, 2112, 111, 0, 2212, -211, 0, | |
2085 | & 2112, 111, 111, 2112, 211, -211, 1114, 211, | |
2086 | & 0, 2114, 111, 0, 2214, -211, 0, 2112, | |
2087 | & 113, 0, 2212, -213, 0, 2112, 221, 0, | |
2088 | & 2212, 111, 0, 2112, 211, 0, 2212, 111, | |
2089 | & 111, 2212, 211, -211, 2224, -211, 0, 2214, | |
2090 | & 111, 0, 2114, 211, 0, 2212, 113, 0, | |
2091 | & 2112, 213, 0, 2212, 221, 0, 2212, -211, | |
2092 | & 0, 2112, 111, 0, 2214, -211, 0, 2114, | |
2093 | & 111, 0, 1114, 211, 0, 2212, -213, 0, | |
2094 | & 2112, 113, 0, 2212, 111, 0, 2112, 211, | |
2095 | & 0, 2224, -211, 0, 2214, 111, 0, 2114, | |
2096 | & 211, 0, 2212, 113, 0, 2112, 213, 0, | |
2097 | & 2212, -211, 0, 2112, 111, 0, 2212, -213, | |
2098 | & 0, 2112, 113, 0, 3122, 311, 0, 3212, | |
2099 | & 311, 0, 3112, 321, 0, 2112, 221, 0, | |
2100 | & 2212, 111, 0, 2112, 211, 0, 2212, 113, | |
2101 | & 0, 2112, 213, 0, 3122, 321, 0, 3222, | |
2102 | & 311, 0, 3212, 321, 0, 2212, 221, 0/ | |
2103 | DATA (isec_linear(K),K= 457, 608) / | |
2104 | & 2112, -211, 0, 2212, -211, 0, 2112, 111, | |
2105 | & 0, 2212, 111, 0, 2112, 211, 0, 2212, | |
2106 | & 211, 0, 2112, -211, 0, 2114, -211, 0, | |
2107 | & 1114, 111, 0, 2112, -213, 0, 2212, -211, | |
2108 | & 0, 2112, 111, 0, 2214, -211, 0, 2114, | |
2109 | & 111, 0, 1114, 211, 0, 2212, -213, 0, | |
2110 | & 2112, 113, 0, 2212, 111, 0, 2112, 211, | |
2111 | & 0, 2224, -211, 0, 2214, 111, 0, 2114, | |
2112 | & 211, 0, 2212, 113, 0, 2112, 213, 0, | |
2113 | & 2212, 211, 0, 2224, 111, 0, 2214, 211, | |
2114 | & 0, 2212, 213, 0, 2212, -211, 0, 2112, | |
2115 | & 111, 0, 2212, 111, 0, 2112, 211, 0, | |
2116 | & 3122, 22, 0, 2112, -211, 0, 3122, 211, | |
2117 | & 0, 3212, 211, 0, 3222, 111, 0, 3122, | |
2118 | & 111, 0, 3222, -211, 0, 3112, 211, 0, | |
2119 | & 3122, -211, 0, 3212, -211, 0, 2112, -311, | |
2120 | & 0, 2212, -321, 0, 3222, -211, 0, 3212, | |
2121 | & 111, 0, 3112, 211, 0, 3122, 221, 0, | |
2122 | & 3224, -211, 0, 3114, 211, 0, 3214, 111/ | |
2123 | DATA (isec_linear(K),K= 609, 760) / | |
2124 | & 0, 2112, -311, 0, 2212, -321, 0, 3122, | |
2125 | & 111, 0, 3122, 223, 0, 3122, 113, 0, | |
2126 | & 3222, -213, 0, 3112, 213, 0, 3212, 113, | |
2127 | & 0, 3122, 221, 0, 3212, 221, 0, 3222, | |
2128 | & -211, 0, 3112, 211, 0, 3212, 111, 0, | |
2129 | & 3122, 111, 0, 3122, -211, 0, 3322, 111, | |
2130 | & 0, 3312, 211, 0, 3322, -211, 0, 3312, | |
2131 | & 111, 0, 3322, -211, 0, 3312, 111, 0, | |
2132 | & 3122, -321, 0, 3222, 221, 0, 3222, 331, | |
2133 | & 0, 2212, -311, 0, 3322, 321, 0, 3224, | |
2134 | & 221, 0, 2214, 331, 0, 2224, -321, 0, | |
2135 | & 3122, 213, 0, 3212, 213, 0, 3222, 113, | |
2136 | & 0, 3222, 223, 0, 2212, -313, 0, 2214, | |
2137 | & -313, 0, 2224, -323, 0, 4122, 211, 0, | |
2138 | & 4122, 111, 0, 4122, -211, 0, 3222, -311, | |
2139 | & 0, 3322, 211, 0, 3222, -313, 0, 3322, | |
2140 | & 213, 0, 3212, -313, 0, 3222, -323, 0, | |
2141 | & 3322, 223, 0, 3312, 213, 0, 3214, -313, | |
2142 | & 0, 3322, -311, 0, 3322, 313, 0, 3334/ | |
2143 | DATA (isec_linear(K),K= 761, 765) / | |
2144 | & 213, 0, 3334, 211, 0/ | |
2145 | DATA (wg_chan(K),K= 1, 114) / | |
2146 | &1.0000E+00,2.8000E-01,2.8000E-01,3.5000E-01,7.0000E-02,2.0000E-02, | |
2147 | &1.0000E+00,9.9000E-01,1.0000E-02,3.8000E-01,3.0000E-02,3.0000E-01, | |
2148 | &2.4000E-01,5.0000E-02,1.0000E+00,0.0000E+00,1.0000E+00,8.8800E-01, | |
2149 | &2.5000E-02,8.7000E-02,4.8000E-01,2.4000E-01,2.6000E-01,2.0000E-02, | |
2150 | &4.9100E-01,3.4400E-01,1.2900E-01,2.4000E-02,1.2000E-02,4.0000E-01, | |
2151 | &3.0000E-01,3.0000E-01,6.0000E-01,4.0000E-01,4.0000E-01,3.0000E-01, | |
2152 | &3.0000E-01,5.0000E-01,5.0000E-01,1.0000E+00,6.4000E-01,2.1000E-01, | |
2153 | &6.0000E-02,2.0000E-02,3.0000E-02,4.0000E-02,6.9000E-01,3.1000E-01, | |
2154 | &2.1000E-01,1.2000E-01,2.7000E-01,4.0000E-01,3.3000E-01,6.7000E-01, | |
2155 | &3.3000E-01,6.7000E-01,3.3000E-01,6.7000E-01,3.3000E-01,6.7000E-01, | |
2156 | &1.9000E-01,3.8000E-01,9.0000E-02,2.0000E-01,3.0000E-02,4.0000E-02, | |
2157 | &5.0000E-02,2.0000E-02,1.9000E-01,3.8000E-01,9.0000E-02,2.0000E-01, | |
2158 | &3.0000E-02,4.0000E-02,5.0000E-02,2.0000E-02,7.0000E-01,3.0000E-01, | |
2159 | &1.0000E-01,5.0000E-01,1.6000E-01,2.4000E-01,5.5000E-01,4.5000E-01, | |
2160 | &6.8000E-01,3.0000E-01,2.0000E-02,3.0000E-01,4.0000E-01,3.0000E-01, | |
2161 | &9.0000E-01,1.0000E-01,4.9000E-01,4.9000E-01,2.0000E-02,1.0000E-01, | |
2162 | &1.0000E-01,8.0000E-01,6.0000E-01,3.0000E-01,1.0000E-01,1.0000E+00, | |
2163 | &1.5000E-01,3.5000E-01,7.0000E-02,1.8000E-01,1.1000E-01,6.0000E-02, | |
2164 | &3.0000E-02,1.0000E-02,3.0000E-02,1.0000E-02,1.5000E-01,3.5000E-01/ | |
2165 | DATA (wg_chan(K),K= 115, 228) / | |
2166 | &7.0000E-02,1.8000E-01,1.1000E-01,6.0000E-02,3.0000E-02,1.0000E-02, | |
2167 | &3.0000E-02,1.0000E-02,3.7000E-01,1.8000E-01,4.0000E-02,8.0000E-02, | |
2168 | &1.3000E-01,1.3000E-01,7.0000E-02,1.8000E-01,3.7000E-01,1.3000E-01, | |
2169 | &8.0000E-02,4.0000E-02,7.0000E-02,1.3000E-01,1.3000E-01,7.0000E-02, | |
2170 | &4.7000E-01,2.3000E-01,5.0000E-02,1.0000E-02,2.0000E-02,2.0000E-02, | |
2171 | &7.0000E-02,1.3000E-01,2.3000E-01,4.7000E-01,5.0000E-02,2.0000E-02, | |
2172 | &1.0000E-02,2.0000E-02,1.0000E+00,3.3000E-01,6.7000E-01,6.7000E-01, | |
2173 | &3.3000E-01,1.0000E+00,2.5000E-01,1.8000E-01,2.7000E-01,3.0000E-01, | |
2174 | &8.0000E-02,1.7000E-01,2.4000E-01,3.0000E-02,1.8000E-01,1.0000E-01, | |
2175 | &2.0000E-01,1.7000E-01,8.0000E-02,1.8000E-01,3.0000E-02,2.4000E-01, | |
2176 | &2.0000E-01,1.0000E-01,2.5000E-01,2.7000E-01,1.8000E-01,3.0000E-01, | |
2177 | &6.4000E-01,3.6000E-01,5.2000E-01,4.8000E-01,1.0000E+00,1.0000E+00, | |
2178 | &8.8000E-01,6.0000E-02,6.0000E-02,8.8000E-01,6.0000E-02,6.0000E-02, | |
2179 | &8.8000E-01,1.2000E-01,1.9000E-01,1.9000E-01,1.6000E-01,1.6000E-01, | |
2180 | &1.7000E-01,3.0000E-02,3.0000E-02,3.0000E-02,4.0000E-02,1.0000E-01, | |
2181 | &1.0000E-01,2.0000E-01,1.2000E-01,1.0000E-01,4.0000E-02,4.0000E-02, | |
2182 | &5.0000E-02,7.5000E-02,7.5000E-02,3.0000E-02,3.0000E-02,4.0000E-02, | |
2183 | &1.0000E+00,1.0000E+00,3.3000E-01,6.7000E-01,6.7000E-01,3.3000E-01, | |
2184 | &2.5000E-01,2.5000E-01,5.0000E-01,2.0000E-02,3.0000E-02,7.0000E-02/ | |
2185 | DATA (wg_chan(K),K= 229, 255) / | |
2186 | &2.0000E-02,2.0000E-02,4.0000E-02,1.3000E-01,7.0000E-02,6.0000E-02, | |
2187 | &6.0000E-02,2.0000E-01,1.4000E-01,4.0000E-02,1.0000E-01,1.0000E+00, | |
2188 | &1.0000E+00,1.0000E+00,2.5000E-01,3.0000E-02,3.0000E-01,4.2000E-01, | |
2189 | &2.2000E-01,3.5000E-01,1.9000E-01,1.6000E-01,8.0000E-02,3.7000E-01, | |
2190 | &2.0000E-01,3.6000E-01,7.0000E-02/ | |
2191 | DATA (id_psm_linear(K),K= 1, 36) / | |
2192 | & 111, 211, -311, 411, 0, 0, -211, 111, | |
2193 | & -321, 421, 0, 0, 311, 321, 221, 431, | |
2194 | & 0, 0, -411, -421, -431, 441, 0, 0, | |
2195 | & 0, 0, 0, 0, 0, 0, 0, 0, | |
2196 | & 0, 0, 0, 0/ | |
2197 | DATA (id_vem_linear(K),K= 1, 36) / | |
2198 | & 113, 213, -313, 413, 0, 0, -213, 113, | |
2199 | & -323, 423, 0, 0, 313, 323, 333, 433, | |
2200 | & 0, 0, -413, -423, -433, 20443, 0, 0, | |
2201 | & 0, 0, 0, 0, 0, 0, 0, 0, | |
2202 | & 0, 0, 0, 0/ | |
2203 | DATA (id_b8_linear(K),K= 1, 171) / | |
2204 | & 1114, 2112, 3112, 4112, 0, 0, 2112, 2212, 3212, | |
2205 | & 4122, 0, 0, 3112, 3212, 3312, 4132, 0, 0, | |
2206 | & 4112, 4122, 4132, 4412, 0, 0, 0, 0, 0, | |
2207 | & 0, 0, 0, 0, 0, 0, 0, 0, 0, | |
2208 | & 2112, 2212, 3212, 4122, 0, 0, 2212, 2224, 3222, | |
2209 | & 4222, 0, 0, 3212, 3222, 3322, 4232, 0, 0, | |
2210 | & 4122, 4222, 4232, 4422, 0, 0, 0, 0, 0, | |
2211 | & 0, 0, 0, 0, 0, 0, 0, 0, 0, | |
2212 | & 3112, 3212, 3312, 4132, 0, 0, 3212, 3222, 3322, | |
2213 | & 4232, 0, 0, 3312, 3322, 3334, 4332, 0, 0, | |
2214 | & 4132, 4232, 4332, 4432, 0, 0, 0, 0, 0, | |
2215 | & 0, 0, 0, 0, 0, 0, 0, 0, 0, | |
2216 | & 4112, 4122, 4132, 4412, 0, 0, 4122, 4222, 4232, | |
2217 | & 4422, 0, 0, 4132, 4232, 4332, 4432, 0, 0, | |
2218 | & 4412, 4422, 4432, 4444, 0, 0, 0, 0, 0, | |
2219 | & 0, 0, 0, 0, 0, 0, 0, 0, 0, | |
2220 | & 0, 0, 0, 0, 0, 0, 0, 0, 0, | |
2221 | & 0, 0, 0, 0, 0, 0, 0, 0, 0, | |
2222 | & 0, 0, 0, 0, 0, 0, 0, 0, 0/ | |
2223 | DATA (id_b8_linear(K),K= 172, 216) / | |
2224 | & 0, 0, 0, 0, 0, 0, 0, 0, 0, | |
2225 | & 0, 0, 0, 0, 0, 0, 0, 0, 0, | |
2226 | & 0, 0, 0, 0, 0, 0, 0, 0, 0, | |
2227 | & 0, 0, 0, 0, 0, 0, 0, 0, 0, | |
2228 | & 0, 0, 0, 0, 0, 0, 0, 0, 0/ | |
2229 | DATA (id_b10_linear(K),K= 1, 171) / | |
2230 | & 1114, 2114, 3114, 4114, 0, 0, 2114, 2214, 3214, | |
2231 | & 4214, 0, 0, 3114, 3214, 3314, 4314, 0, 0, | |
2232 | & 4114, 4214, 4314, 4414, 0, 0, 0, 0, 0, | |
2233 | & 0, 0, 0, 0, 0, 0, 0, 0, 0, | |
2234 | & 2114, 2214, 3214, 4214, 0, 0, 2214, 2224, 3224, | |
2235 | & 4224, 0, 0, 3214, 3224, 3324, 4324, 0, 0, | |
2236 | & 4214, 4224, 4324, 4424, 0, 0, 0, 0, 0, | |
2237 | & 0, 0, 0, 0, 0, 0, 0, 0, 0, | |
2238 | & 3114, 3214, 3314, 4314, 0, 0, 3214, 3224, 3324, | |
2239 | & 4324, 0, 0, 3314, 3324, 3334, 4334, 0, 0, | |
2240 | & 4314, 4324, 4334, 4434, 0, 0, 0, 0, 0, | |
2241 | & 0, 0, 0, 0, 0, 0, 0, 0, 0, | |
2242 | & 4114, 4214, 4314, 4414, 0, 0, 4214, 4224, 4324, | |
2243 | & 4424, 0, 0, 4314, 4324, 4334, 4434, 0, 0, | |
2244 | & 4414, 4424, 4434, 4444, 0, 0, 0, 0, 0, | |
2245 | & 0, 0, 0, 0, 0, 0, 0, 0, 0, | |
2246 | & 0, 0, 0, 0, 0, 0, 0, 0, 0, | |
2247 | & 0, 0, 0, 0, 0, 0, 0, 0, 0, | |
2248 | & 0, 0, 0, 0, 0, 0, 0, 0, 0/ | |
2249 | DATA (id_b10_linear(K),K= 172, 216) / | |
2250 | & 0, 0, 0, 0, 0, 0, 0, 0, 0, | |
2251 | & 0, 0, 0, 0, 0, 0, 0, 0, 0, | |
2252 | & 0, 0, 0, 0, 0, 0, 0, 0, 0, | |
2253 | & 0, 0, 0, 0, 0, 0, 0, 0, 0, | |
2254 | & 0, 0, 0, 0, 0, 0, 0, 0, 0/ | |
2255 | ||
2256 | ID_pdg_max = i_tab_max | |
2257 | ||
2258 | C copy from local to global variables | |
2259 | do i=1,i_tab_max | |
2260 | ID_pdg_list(i) = number(i) | |
2261 | name_list(i) = name(i) | |
2262 | xm_list(i) = xmass(i) | |
2263 | gam_list(i) = gamma(i) | |
2264 | ich3_list(i) = ich3(i) | |
2265 | iba3_list(i) = iba3(i) | |
2266 | do j=1,3 | |
2267 | iq_list(j,i) = iq_linear(3*(i-1)+j) | |
2268 | idec_list(j,i) = idec_linear(3*(i-1)+j) | |
2269 | enddo | |
2270 | enddo | |
2271 | ||
2272 | C initialize hash table | |
2273 | call pho_cpcini(ID_pdg_max,ID_pdg_list,ID_list) | |
2274 | ||
2275 | itmp = IDEB(71) | |
2276 | IDEB(71) = -1 | |
2277 | ||
2278 | C quark index table for mesons | |
2279 | do i=1,6 | |
2280 | do j=1,6 | |
2281 | id_psm_list(i,j) = ipho_pdg2id(id_psm_linear(6*(j-1)+i)) | |
2282 | id_vem_list(i,j) = ipho_pdg2id(id_vem_linear(6*(j-1)+i)) | |
2283 | enddo | |
2284 | enddo | |
2285 | ||
2286 | C quark index table for baryons | |
2287 | do i=1,6 | |
2288 | do j=1,6 | |
2289 | do k=1,6 | |
2290 | id_b8_list(i,j,k) = | |
2291 | & ipho_pdg2id(id_b8_linear(36*(k-1)+6*(j-1)+i)) | |
2292 | id_b10_list(i,j,k) = | |
2293 | & ipho_pdg2id(id_b10_linear(36*(k-1)+6*(j-1)+i)) | |
2294 | enddo | |
2295 | enddo | |
2296 | enddo | |
2297 | ||
2298 | IDEB(71) = itmp | |
2299 | ||
2300 | C copy secondary particles | |
2301 | C (translate PDG-ID to CPC and sort according to CPC) | |
2302 | ichan = 0 | |
2303 | do i=1,i_tab_max | |
2304 | if(idec_list(1,i).ne.0) then | |
2305 | do j=idec_list(2,i),idec_list(3,i) | |
2306 | ichan = ichan+1 | |
2307 | wg_sec_list(ichan) = wg_chan(j) | |
2308 | do k=1,3 | |
2309 | if(isec_linear(3*(j-1)+k).ne.0) then | |
2310 | isec_list(k,ichan) = ipho_pdg2id(isec_linear(3*(j-1)+k)) | |
2311 | else | |
2312 | isec_list(k,ichan) = 0 | |
2313 | endif | |
2314 | enddo | |
2315 | enddo | |
2316 | endif | |
2317 | enddo | |
2318 | ||
2319 | C add two-pion background (low-mass photon dissociation) | |
2320 | i = ipho_pdg2id(92) | |
2321 | ichan = ichan+1 | |
2322 | idec_list(1,i) = 1 | |
2323 | idec_list(2,i) = ichan | |
2324 | idec_list(3,i) = ichan | |
2325 | wg_sec_list(ichan) = 1.D0 | |
2326 | isec_list(1,ichan) = ipho_pdg2id(211) | |
2327 | isec_list(2,ichan) = ipho_pdg2id(-211) | |
2328 | isec_list(3,ichan) = 0 | |
2329 | ||
2330 | C min. mass limits for strings: q-qbar | |
2331 | do i=1,6 | |
2332 | do j=1,6 | |
2333 | AM2P = 1000.D0 | |
2334 | AM2V = 1000.D0 | |
2335 | do k=1,3 | |
2336 | C pseudo-scalar mesons | |
2337 | i1 = iabs(id_psm_list(i,k)) | |
2338 | if(i1.ne.0) then | |
2339 | AM1 = xm_list(i1) | |
2340 | else | |
2341 | AM1 = pho_pmass(i,3)+pho_pmass(k,3) | |
2342 | endif | |
2343 | i2 = iabs(id_psm_list(k,j)) | |
2344 | if(i2.ne.0) then | |
2345 | AM2 = xm_list(i2) | |
2346 | else | |
2347 | AM2 = pho_pmass(k,3)+pho_pmass(j,3) | |
2348 | endif | |
2349 | AM2P = MIN(AM2P,AM1+AM2) | |
2350 | C vector mesons | |
2351 | i1 = iabs(id_vem_list(i,k)) | |
2352 | if(i1.ne.0) then | |
2353 | AM1 = xm_list(i1) | |
2354 | else | |
2355 | AM1 = pho_pmass(i,3)+pho_pmass(k,3) | |
2356 | endif | |
2357 | i2 = iabs(id_vem_list(k,j)) | |
2358 | if(i2.ne.0) then | |
2359 | AM2 = xm_list(i2) | |
2360 | else | |
2361 | AM2 = pho_pmass(k,3)+pho_pmass(j,3) | |
2362 | endif | |
2363 | AM2V = MIN(AM2V,AM1+AM2) | |
2364 | enddo | |
2365 | xm_psm2_list(i,j) = AM2P | |
2366 | xm_vem2_list(i,j) = AM2V | |
2367 | enddo | |
2368 | enddo | |
2369 | ||
2370 | C min. mass limits for strings: qq-q | |
2371 | do i=1,6 | |
2372 | do j=1,6 | |
2373 | do k=1,6 | |
2374 | AM82 = 1000.D0 | |
2375 | AM102 = 1000.D0 | |
2376 | do l=1,3 | |
2377 | C pseudo-scalar meson | |
2378 | i1 = iabs(id_psm_list(k,l)) | |
2379 | if(i1.ne.0) then | |
2380 | AM1 = xm_list(i1) | |
2381 | else | |
2382 | AM1 = pho_pmass(i,3)+pho_pmass(k,3) | |
2383 | endif | |
2384 | C vector meson | |
2385 | i2 = iabs(id_vem_list(k,l)) | |
2386 | if(i2.ne.0) then | |
2387 | AM2 = xm_list(i2) | |
2388 | else | |
2389 | AM2 = pho_pmass(i,3)+pho_pmass(k,3) | |
2390 | endif | |
2391 | C octet baryon | |
2392 | AMM = min(AM1,AM2) | |
2393 | K8 = id_b8_list(i,j,l) | |
2394 | if(K8.ne.0) then | |
2395 | AM1 = xm_list(K8) | |
2396 | else | |
2397 | AM1 = pho_pmass(i,3)+pho_pmass(j,3)+pho_pmass(l,3) | |
2398 | endif | |
2399 | AM82 = MIN(AM82, AM1 + AMM) | |
2400 | C decuplet baryon | |
2401 | K10 = id_b10_list(i,j,l) | |
2402 | if(K10.ne.0) then | |
2403 | AM2 = xm_list(K10) | |
2404 | else | |
2405 | AM2 = pho_pmass(i,3)+pho_pmass(j,3)+pho_pmass(l,3) | |
2406 | endif | |
2407 | AM102 = MIN(AM102, AM2 + AMM) | |
2408 | enddo | |
2409 | xm_b82_list(i,j,k) = AM82 | |
2410 | xm_b102_list(i,j,k) = AM102 | |
2411 | enddo | |
2412 | enddo | |
2413 | enddo | |
2414 | ||
2415 | C min. mass limits for strings: qq-qbarqbar | |
2416 | do i=1,6 | |
2417 | do j=1,6 | |
2418 | do ii=1,6 | |
2419 | do jj=1,6 | |
2420 | AM82 = 1000.D0 | |
2421 | AM102 = 1000.D0 | |
2422 | do l=1,3 | |
2423 | C octet baryons | |
2424 | K8 = id_b8_list(i,j,l) | |
2425 | if(K8.ne.0) then | |
2426 | AM1 = xm_list(K8) | |
2427 | else | |
2428 | AM1 = pho_pmass(i,3)+pho_pmass(j,3)+pho_pmass(l,3) | |
2429 | endif | |
2430 | L8 = id_b8_list(ii,jj,l) | |
2431 | if(L8.ne.0) then | |
2432 | AM2 = xm_list(L8) | |
2433 | else | |
2434 | AM2 = pho_pmass(ii,3)+pho_pmass(jj,3)+pho_pmass(l,3) | |
2435 | endif | |
2436 | AM82 = MIN(AM82, AM1+AM2) | |
2437 | C decuplet baryons | |
2438 | K10 = id_b10_list(i,j,l) | |
2439 | if(K10.ne.0) then | |
2440 | AM1 = xm_list(K10) | |
2441 | else | |
2442 | AM1 = pho_pmass(i,3)+pho_pmass(j,3)+pho_pmass(l,3) | |
2443 | endif | |
2444 | L10 = id_b10_list(ii,jj,l) | |
2445 | if(L10.ne.0) then | |
2446 | AM2 = xm_list(L10) | |
2447 | else | |
2448 | AM2 = pho_pmass(ii,3)+pho_pmass(jj,3)+pho_pmass(l,3) | |
2449 | endif | |
2450 | AM102 = MIN(AM102, AM1+AM2) | |
2451 | enddo | |
2452 | xm_bb82_list(i,j,ii,jj) = AM82 | |
2453 | xm_bb102_list(i,j,ii,jj) = AM102 | |
2454 | enddo | |
2455 | enddo | |
2456 | enddo | |
2457 | enddo | |
2458 | ||
2459 | END | |
2460 | ||
2461 | *$ CREATE PHO_PRESEL.FOR | |
2462 | *COPY PHO_PRESEL | |
2463 | CDECK ID>, PHO_PRESEL | |
2464 | SUBROUTINE PHO_PRESEL(MODE,IREJ) | |
2465 | C********************************************************************** | |
2466 | C | |
2467 | C user specific function to pre-select events during generation | |
2468 | C | |
2469 | C input: MODE 5 electron and photon kinematics | |
2470 | C 10 process and number of cut Pomerons | |
2471 | C 15 partons without construction of strings | |
2472 | C 20 partons assigned to strings | |
2473 | C 25 after fragmentation, complete final state | |
2474 | C | |
2475 | C output: IREJ 0 event accepted | |
2476 | C 50 event rejected | |
2477 | C | |
2478 | C********************************************************************** | |
2479 | IMPLICIT DOUBLE PRECISION (A-H,O-Z) | |
2480 | SAVE | |
2481 | ||
2482 | C input/output channels | |
2483 | INTEGER LI,LO | |
2484 | COMMON /POINOU/ LI,LO | |
2485 | C event debugging information | |
2486 | INTEGER NMAXD | |
2487 | PARAMETER (NMAXD=100) | |
2488 | INTEGER IDEB,KSPOM,KHPOM,KSREG,KHDIR,KACCEP,KSTRG,KHTRG,KSLOO, | |
2489 | & KHLOO,KSDPO,KHDPO,KEVENT,KSOFT,KHARD | |
2490 | COMMON /PODEBG/ IDEB(NMAXD),KSPOM,KHPOM,KSREG,KHDIR,KACCEP,KSTRG, | |
2491 | & KHTRG,KSLOO,KHLOO,KSDPO,KHDPO,KEVENT,KSOFT,KHARD | |
2492 | C standard particle data interface | |
2493 | INTEGER NMXHEP | |
2494 | PARAMETER (NMXHEP=4000) | |
2495 | INTEGER NEVHEP,NHEP,ISTHEP,IDHEP,JMOHEP,JDAHEP | |
2496 | DOUBLE PRECISION PHEP,VHEP | |
2497 | COMMON /POEVT1/ NEVHEP,NHEP,ISTHEP(NMXHEP),IDHEP(NMXHEP), | |
2498 | & JMOHEP(2,NMXHEP),JDAHEP(2,NMXHEP),PHEP(5,NMXHEP), | |
2499 | & VHEP(4,NMXHEP) | |
2500 | C extension to standard particle data interface (PHOJET specific) | |
2501 | INTEGER IMPART,IPHIST,ICOLOR | |
2502 | COMMON /POEVT2/ IMPART(NMXHEP),IPHIST(2,NMXHEP),ICOLOR(2,NMXHEP) | |
2503 | C global event kinematics and particle IDs | |
2504 | INTEGER IFPAP,IFPAB | |
2505 | DOUBLE PRECISION ECM,PCM,PMASS,PVIRT | |
2506 | COMMON /POGCMS/ ECM,PCM,PMASS(2),PVIRT(2),IFPAP(2),IFPAB(2) | |
2507 | C gamma-lepton or gamma-hadron vertex information | |
2508 | INTEGER IGHEL,IDPSRC,IDBSRC | |
2509 | DOUBLE PRECISION PINI,PFIN,PGAM,GYY,GQ2,GGECM,GAIMP,PFTHE,PFPHI, | |
2510 | & RADSRC,AMSRC,GAMSRC | |
2511 | COMMON /POFSRC/ PINI(5,2),PFIN(5,2),PGAM(5,2),IGHEL(2), | |
2512 | & GYY(2),GQ2(2),GGECM,GAIMP(2),PFTHE(2),PFPHI(2), | |
2513 | & IDPSRC(2),IDBSRC(2),RADSRC(2),AMSRC(2),GAMSRC(2) | |
2514 | C hard scattering data | |
2515 | INTEGER MSCAHD | |
2516 | PARAMETER ( MSCAHD = 50 ) | |
2517 | INTEGER LSCAHD,LSC1HD,LSIDX, | |
2518 | & NINHD,N0INHD,NIVAL,N0IVAL,NOUTHD,NBRAHD,NPROHD | |
2519 | DOUBLE PRECISION PPH,PTHD,ETAHD,Q2SCA,PDFVA,XHD,VHD,X0HD | |
2520 | COMMON /POHSLT/ LSCAHD,LSC1HD,LSIDX(MSCAHD), | |
2521 | & PPH(8*MSCAHD,2),PTHD(MSCAHD),ETAHD(MSCAHD,2), | |
2522 | & Q2SCA(MSCAHD,2),PDFVA(MSCAHD,2), | |
2523 | & XHD(MSCAHD,2),VHD(MSCAHD),X0HD(MSCAHD,2), | |
2524 | & NINHD(MSCAHD,2),N0INHD(MSCAHD,2), | |
2525 | & NIVAL(MSCAHD,2),N0IVAL(MSCAHD,2), | |
2526 | & NOUTHD(MSCAHD,2),NBRAHD(MSCAHD,2),NPROHD(MSCAHD) | |
2527 | C event weights and generated cross section | |
2528 | INTEGER IPOWGC,ISWCUT,IVWGHT | |
2529 | DOUBLE PRECISION SIGGEN,HSWGHT,HSWCUT,EVWGHT | |
2530 | COMMON /POWGHT/ SIGGEN(4),HSWGHT(0:10),HSWCUT(20),EVWGHT(0:10), | |
2531 | & IPOWGC(0:10),ISWCUT(20),IVWGHT(0:10) | |
2532 | ||
2533 | IREJ = 0 | |
2534 | ||
2535 | * XBJ = GQ2(2)/(GGECM**2+GQ2(2)) | |
2536 | * IF(XBJ.LT.0.002D0) IREJ = 1 | |
2537 | ||
2538 | END | |
2539 | ||
2540 | *$ CREATE PHO_FIXCOL.FOR | |
2541 | *COPY PHO_FIXCOL | |
2542 | CDECK ID>, PHO_FIXCOL | |
2543 | SUBROUTINE PHO_FIXCOL(E1,E2,THETA,PHI,NEV) | |
2544 | C********************************************************************** | |
2545 | C | |
2546 | C interface to call PHOJET (fixed energy run) with | |
2547 | C collider kinematics | |
2548 | C | |
2549 | C equivalen photon approximation to get photon flux | |
2550 | C | |
2551 | C input: NEV number of events to generate | |
2552 | C THETA azimuthal angle (micro radians) | |
2553 | C PHI beam crossing angle | |
2554 | C (with respect to x, in degrees) | |
2555 | C E1 energy of particle 1 (+z direction, GeV) | |
2556 | C E2 energy of particle 2 (-z direction, GeV) | |
2557 | C | |
2558 | C note: particle types have to be specified before | |
2559 | C with PHO_SETPAR | |
2560 | C | |
2561 | C********************************************************************** | |
2562 | IMPLICIT DOUBLE PRECISION (A-H,O-Z) | |
2563 | SAVE | |
2564 | ||
2565 | PARAMETER(TWOPI=6.283185307D0,BOG=TWOPI/360.0D0) | |
2566 | ||
2567 | C input/output channels | |
2568 | INTEGER LI,LO | |
2569 | COMMON /POINOU/ LI,LO | |
2570 | C event debugging information | |
2571 | INTEGER NMAXD | |
2572 | PARAMETER (NMAXD=100) | |
2573 | INTEGER IDEB,KSPOM,KHPOM,KSREG,KHDIR,KACCEP,KSTRG,KHTRG,KSLOO, | |
2574 | & KHLOO,KSDPO,KHDPO,KEVENT,KSOFT,KHARD | |
2575 | COMMON /PODEBG/ IDEB(NMAXD),KSPOM,KHPOM,KSREG,KHDIR,KACCEP,KSTRG, | |
2576 | & KHTRG,KSLOO,KHLOO,KSDPO,KHDPO,KEVENT,KSOFT,KHARD | |
2577 | C general process information | |
2578 | INTEGER IPROCE,IDNODF,IDIFR1,IDIFR2,IDDPOM,IPRON | |
2579 | COMMON /POPRCS/ IPROCE,IDNODF,IDIFR1,IDIFR2,IDDPOM,IPRON(15,4) | |
2580 | C global event kinematics and particle IDs | |
2581 | INTEGER IFPAP,IFPAB | |
2582 | DOUBLE PRECISION ECM,PCM,PMASS,PVIRT | |
2583 | COMMON /POGCMS/ ECM,PCM,PMASS(2),PVIRT(2),IFPAP(2),IFPAB(2) | |
2584 | C model switches and parameters | |
2585 | CHARACTER*8 MDLNA | |
2586 | INTEGER ISWMDL,IPAMDL | |
2587 | DOUBLE PRECISION PARMDL | |
2588 | COMMON /POMDLS/ MDLNA(50),ISWMDL(50),PARMDL(400),IPAMDL(400) | |
2589 | C nucleon-nucleus / nucleus-nucleus interface to DPMJET | |
2590 | INTEGER IDEQP,IDEQB,IHFLD,IHFLS | |
2591 | DOUBLE PRECISION ECMN,PCMN,SECM,SPCM,XPSUB,XTSUB | |
2592 | COMMON /POHDFL/ ECMN,PCMN,SECM,SPCM,XPSUB,XTSUB, | |
2593 | & IDEQP(2),IDEQB(2),IHFLD(2,2),IHFLS(2) | |
2594 | C integration precision for hard cross sections (obsolete) | |
2595 | INTEGER NGAUP1,NGAUP2,NGAUET,NGAUIN,NGAUSO | |
2596 | COMMON /POGAUP/ NGAUP1,NGAUP2,NGAUET,NGAUIN,NGAUSO | |
2597 | C event weights and generated cross section | |
2598 | INTEGER IPOWGC,ISWCUT,IVWGHT | |
2599 | DOUBLE PRECISION SIGGEN,HSWGHT,HSWCUT,EVWGHT | |
2600 | COMMON /POWGHT/ SIGGEN(4),HSWGHT(0:10),HSWCUT(20),EVWGHT(0:10), | |
2601 | & IPOWGC(0:10),ISWCUT(20),IVWGHT(0:10) | |
2602 | ||
2603 | DIMENSION P1(4),P2(4) | |
2604 | ||
2605 | C remnant initialization (only needed for DPMJET) | |
2606 | ISAVP1 = IFPAP(1) | |
2607 | ISAVB1 = IFPAB(1) | |
2608 | IF(IFPAP(1).EQ.81) THEN | |
2609 | IFPAP(1) = IDEQP(1) | |
2610 | IFPAB(1) = IDEQB(1) | |
2611 | ENDIF | |
2612 | ISAVP2 = IFPAP(2) | |
2613 | ISAVB2 = IFPAB(2) | |
2614 | IF(IFPAP(2).EQ.82) THEN | |
2615 | IFPAP(2) = IDEQP(2) | |
2616 | IFPAB(2) = IDEQB(2) | |
2617 | ENDIF | |
2618 | PMASS1 = PHO_PMASS(IFPAB(1),0)-SQRT(PVIRT(1)) | |
2619 | PMASS2 = PHO_PMASS(IFPAB(2),0)-SQRT(PVIRT(2)) | |
2620 | PP1 = SQRT(E1**2-PMASS1**2) | |
2621 | PP2 = SQRT(E2**2-PMASS2**2) | |
2622 | C beam crossing angle | |
2623 | TH = 1.D-6*THETA/2.D0 | |
2624 | PH = PHI*BOG | |
2625 | P1(1) = PP1*SIN(TH)*COS(PH) | |
2626 | P1(2) = PP1*SIN(TH)*SIN(PH) | |
2627 | P1(3) = PP1*COS(TH) | |
2628 | P1(4) = E1 | |
2629 | P2(1) = PP2*SIN(TH)*COS(PH) | |
2630 | P2(2) = PP2*SIN(TH)*SIN(PH) | |
2631 | P2(3) = -PP2*COS(TH) | |
2632 | P2(4) = E2 | |
2633 | CALL PHO_EVENT(-1,P1,P2,SIGMAX,IREJ) | |
2634 | IFPAP(1) = ISAVP1 | |
2635 | IFPAB(1) = ISAVB1 | |
2636 | IFPAP(2) = ISAVP2 | |
2637 | IFPAB(2) = ISAVB2 | |
2638 | ITRY = 0 | |
2639 | CALL PHO_PHIST(-1,SIGMAX) | |
2640 | CALL PHO_LHIST(-1,SIGMAX) | |
2641 | C test of DPMJET interface (default is IPAMDL(13)=0) | |
2642 | if(IPAMDL(13).gt.0) then | |
2643 | MODE = IPAMDL(13) | |
2644 | IPAMDL(13) = 0 | |
2645 | else | |
2646 | MODE = 1 | |
2647 | endif | |
2648 | C main generation loop | |
2649 | DO 50 I=1,NEV | |
2650 | 55 CONTINUE | |
2651 | ITRY = ITRY+1 | |
2652 | CALL PHO_EVENT(MODE,P1,P2,SIGCUR,IREJ) | |
2653 | IF(IREJ.NE.0) GOTO 55 | |
2654 | CALL PHO_PHIST(1,HSWGHT(0)) | |
2655 | CALL PHO_LHIST(1,HSWGHT(0)) | |
2656 | 50 CONTINUE | |
2657 | ||
2658 | IF(NEV.GT.0) THEN | |
2659 | SIGMAX = SIGMAX*DBLE(NEV)/DBLE(ITRY) | |
2660 | WRITE(LO,'(//1X,A,/1X,A,1PE12.3,A,/1X,A)') | |
2661 | & '=========================================================', | |
2662 | & ' ***** simulated cross section: ',SIGMAX,' mb *****', | |
2663 | & '=========================================================' | |
2664 | CALL PHO_EVENT(-2,P1,P2,SIGCUR,IREJ) | |
2665 | CALL PHO_PHIST(-2,SIGMAX) | |
2666 | CALL PHO_LHIST(-2,SIGMAX) | |
2667 | ELSE | |
2668 | WRITE(LO,'(1X,A,I5)') 'POFCOL: no events simulated',NEV | |
2669 | ENDIF | |
2670 | ||
2671 | END | |
2672 | ||
2673 | *$ CREATE PHO_FIXLAB.FOR | |
2674 | *COPY PHO_FIXLAB | |
2675 | CDECK ID>, PHO_FIXLAB | |
2676 | SUBROUTINE PHO_FIXLAB(PLAB,NEV) | |
2677 | C********************************************************************** | |
2678 | C | |
2679 | C interface to call PHOJET (fixed energy run) with | |
2680 | C LAB kinematics (second particle as target) | |
2681 | C | |
2682 | C equivalent photon approximation to get photon flux | |
2683 | C | |
2684 | C input: NEV number of events to generate | |
2685 | C PLAB LAB momentum of particle 1 | |
2686 | C | |
2687 | C note: particle types have to be specified before | |
2688 | C with PHO_SETPAR | |
2689 | C | |
2690 | C********************************************************************** | |
2691 | IMPLICIT DOUBLE PRECISION (A-H,O-Z) | |
2692 | SAVE | |
2693 | ||
2694 | C input/output channels | |
2695 | INTEGER LI,LO | |
2696 | COMMON /POINOU/ LI,LO | |
2697 | C event debugging information | |
2698 | INTEGER NMAXD | |
2699 | PARAMETER (NMAXD=100) | |
2700 | INTEGER IDEB,KSPOM,KHPOM,KSREG,KHDIR,KACCEP,KSTRG,KHTRG,KSLOO, | |
2701 | & KHLOO,KSDPO,KHDPO,KEVENT,KSOFT,KHARD | |
2702 | COMMON /PODEBG/ IDEB(NMAXD),KSPOM,KHPOM,KSREG,KHDIR,KACCEP,KSTRG, | |
2703 | & KHTRG,KSLOO,KHLOO,KSDPO,KHDPO,KEVENT,KSOFT,KHARD | |
2704 | C general process information | |
2705 | INTEGER IPROCE,IDNODF,IDIFR1,IDIFR2,IDDPOM,IPRON | |
2706 | COMMON /POPRCS/ IPROCE,IDNODF,IDIFR1,IDIFR2,IDDPOM,IPRON(15,4) | |
2707 | C global event kinematics and particle IDs | |
2708 | INTEGER IFPAP,IFPAB | |
2709 | DOUBLE PRECISION ECM,PCM,PMASS,PVIRT | |
2710 | COMMON /POGCMS/ ECM,PCM,PMASS(2),PVIRT(2),IFPAP(2),IFPAB(2) | |
2711 | C model switches and parameters | |
2712 | CHARACTER*8 MDLNA | |
2713 | INTEGER ISWMDL,IPAMDL | |
2714 | DOUBLE PRECISION PARMDL | |
2715 | COMMON /POMDLS/ MDLNA(50),ISWMDL(50),PARMDL(400),IPAMDL(400) | |
2716 | C nucleon-nucleus / nucleus-nucleus interface to DPMJET | |
2717 | INTEGER IDEQP,IDEQB,IHFLD,IHFLS | |
2718 | DOUBLE PRECISION ECMN,PCMN,SECM,SPCM,XPSUB,XTSUB | |
2719 | COMMON /POHDFL/ ECMN,PCMN,SECM,SPCM,XPSUB,XTSUB, | |
2720 | & IDEQP(2),IDEQB(2),IHFLD(2,2),IHFLS(2) | |
2721 | C integration precision for hard cross sections (obsolete) | |
2722 | INTEGER NGAUP1,NGAUP2,NGAUET,NGAUIN,NGAUSO | |
2723 | COMMON /POGAUP/ NGAUP1,NGAUP2,NGAUET,NGAUIN,NGAUSO | |
2724 | C event weights and generated cross section | |
2725 | INTEGER IPOWGC,ISWCUT,IVWGHT | |
2726 | DOUBLE PRECISION SIGGEN,HSWGHT,HSWCUT,EVWGHT | |
2727 | COMMON /POWGHT/ SIGGEN(4),HSWGHT(0:10),HSWCUT(20),EVWGHT(0:10), | |
2728 | & IPOWGC(0:10),ISWCUT(20),IVWGHT(0:10) | |
2729 | ||
2730 | DIMENSION P1(4),P2(4) | |
2731 | ||
2732 | C remnant initialization (only needed for DPMJET) | |
2733 | SPCM = PLAB | |
2734 | ISAVP1 = IFPAP(1) | |
2735 | ISAVB1 = IFPAB(1) | |
2736 | IF(IFPAP(1).EQ.81) THEN | |
2737 | IFPAP(1) = IDEQP(1) | |
2738 | IFPAB(1) = IDEQB(1) | |
2739 | ENDIF | |
2740 | ISAVP2 = IFPAP(2) | |
2741 | ISAVB2 = IFPAB(2) | |
2742 | IF(IFPAP(2).EQ.82) THEN | |
2743 | IFPAP(2) = IDEQP(2) | |
2744 | IFPAB(2) = IDEQB(2) | |
2745 | ENDIF | |
2746 | C get momenta in LAB system | |
2747 | PMASS1 = PHO_PMASS(IFPAB(1),0)**2-PVIRT(1) | |
2748 | PMASS2 = PHO_PMASS(IFPAB(2),0)**2-PVIRT(2) | |
2749 | IF(PMASS2.LT.0.1D0) THEN | |
2750 | WRITE(LO,'(/1X,2A,2I7)') 'PHO_FIXLAB:ERROR: ', | |
2751 | & 'no LAB system possible',IFPAB(1),IFPAB(2) | |
2752 | ELSE | |
2753 | P1(1) = 0.D0 | |
2754 | P1(2) = 0.D0 | |
2755 | P1(3) = PLAB | |
2756 | P1(4) = SQRT(PMASS1+PLAB**2) | |
2757 | P2(1) = 0.D0 | |
2758 | P2(2) = 0.D0 | |
2759 | P2(3) = 0.D0 | |
2760 | P2(4) = SQRT(PMASS2) | |
2761 | CALL PHO_EVENT(-1,P1,P2,SIGMAX,IREJ) | |
2762 | IFPAP(1) = ISAVP1 | |
2763 | IFPAB(1) = ISAVB1 | |
2764 | IFPAP(2) = ISAVP2 | |
2765 | IFPAB(2) = ISAVB2 | |
2766 | ITRY = 0 | |
2767 | CALL PHO_PHIST(-1,SIGMAX) | |
2768 | CALL PHO_LHIST(-1,SIGMAX) | |
2769 | C event generation loop | |
2770 | DO 40 I=1,NEV | |
2771 | 45 CONTINUE | |
2772 | ITRY = ITRY+1 | |
2773 | CALL PHO_EVENT(1,P1,P2,SIGCUR,IREJ) | |
2774 | IF(IREJ.NE.0) GOTO 45 | |
2775 | CALL PHO_LHIST(1,HSWGHT(0)) | |
2776 | CALL PHO_PHIST(10,HSWGHT(0)) | |
2777 | 40 CONTINUE | |
2778 | IF(NEV.GT.0) THEN | |
2779 | SIGMAX = SIGMAX*DBLE(NEV)/DBLE(ITRY) | |
2780 | WRITE(LO,'(//1X,A,/1X,A,1PE12.3,A,/1X,A)') | |
2781 | & '=========================================================', | |
2782 | & ' ***** simulated cross section: ',SIGMAX,' mb *****', | |
2783 | & '=========================================================' | |
2784 | CALL PHO_EVENT(-2,P1,P2,SIGCUR,IREJ) | |
2785 | CALL PHO_PHIST(-2,SIGMAX) | |
2786 | CALL PHO_LHIST(-2,SIGMAX) | |
2787 | ELSE | |
2788 | WRITE(LO,'(1X,A,I5)') | |
2789 | & 'PHO_FIXLAB: no events simulated',NEV | |
2790 | ENDIF | |
2791 | ENDIF | |
2792 | ||
2793 | END | |
2794 | ||
2795 | *$ CREATE PHO_GPHERA.FOR | |
2796 | *COPY PHO_GPHERA | |
2797 | CDECK ID>, PHO_GPHERA | |
2798 | SUBROUTINE PHO_GPHERA(NEVENT,EE1,EE2) | |
2799 | C********************************************************************** | |
2800 | C | |
2801 | C interface to call PHOJET (variable energy run) with | |
2802 | C HERA kinematics, photon as particle 2 | |
2803 | C | |
2804 | C equivalent photon approximation to get photon flux | |
2805 | C | |
2806 | C input: NEVENT number of events to generate | |
2807 | C EE1 proton energy (LAB system) | |
2808 | C EE2 electron energy (LAB system) | |
2809 | C from /POFCUT/: | |
2810 | C YMIN2 lower limit of Y | |
2811 | C (energy fraction taken by photon from electron) | |
2812 | C YMAX2 upper limit of Y | |
2813 | C Q2MIN2 lower limit of photon virtuality | |
2814 | C Q2MAX2 upper limit of photon virtuality | |
2815 | C | |
2816 | C********************************************************************** | |
2817 | IMPLICIT DOUBLE PRECISION (A-H,O-Z) | |
2818 | SAVE | |
2819 | ||
2820 | PARAMETER ( DEPS = 1.D-10, | |
2821 | & PI = 3.14159265359D0 ) | |
2822 | ||
2823 | C input/output channels | |
2824 | INTEGER LI,LO | |
2825 | COMMON /POINOU/ LI,LO | |
2826 | C event debugging information | |
2827 | INTEGER NMAXD | |
2828 | PARAMETER (NMAXD=100) | |
2829 | INTEGER IDEB,KSPOM,KHPOM,KSREG,KHDIR,KACCEP,KSTRG,KHTRG,KSLOO, | |
2830 | & KHLOO,KSDPO,KHDPO,KEVENT,KSOFT,KHARD | |
2831 | COMMON /PODEBG/ IDEB(NMAXD),KSPOM,KHPOM,KSREG,KHDIR,KACCEP,KSTRG, | |
2832 | & KHTRG,KSLOO,KHLOO,KSDPO,KHDPO,KEVENT,KSOFT,KHARD | |
2833 | C model switches and parameters | |
2834 | CHARACTER*8 MDLNA | |
2835 | INTEGER ISWMDL,IPAMDL | |
2836 | DOUBLE PRECISION PARMDL | |
2837 | COMMON /POMDLS/ MDLNA(50),ISWMDL(50),PARMDL(400),IPAMDL(400) | |
2838 | C photon flux kinematics and cuts | |
2839 | DOUBLE PRECISION ECMIN,ECMAX,EEMIN1,EEMIN2, | |
2840 | & YMIN1,YMAX1,YMIN2,YMAX2, | |
2841 | & Q2MIN1,Q2MAX1,Q2MIN2,Q2MAX2, | |
2842 | & THMIN1,THMAX1,THMIN2,THMAX2 | |
2843 | INTEGER ITAG1,ITAG2 | |
2844 | COMMON /POFCUT/ ECMIN,ECMAX,EEMIN1,EEMIN2, | |
2845 | & YMIN1,YMAX1,YMIN2,YMAX2, | |
2846 | & Q2MIN1,Q2MAX1,Q2MIN2,Q2MAX2, | |
2847 | & THMIN1,THMAX1,THMIN2,THMAX2, | |
2848 | & ITAG1,ITAG2 | |
2849 | C gamma-lepton or gamma-hadron vertex information | |
2850 | INTEGER IGHEL,IDPSRC,IDBSRC | |
2851 | DOUBLE PRECISION PINI,PFIN,PGAM,GYY,GQ2,GGECM,GAIMP,PFTHE,PFPHI, | |
2852 | & RADSRC,AMSRC,GAMSRC | |
2853 | COMMON /POFSRC/ PINI(5,2),PFIN(5,2),PGAM(5,2),IGHEL(2), | |
2854 | & GYY(2),GQ2(2),GGECM,GAIMP(2),PFTHE(2),PFPHI(2), | |
2855 | & IDPSRC(2),IDBSRC(2),RADSRC(2),AMSRC(2),GAMSRC(2) | |
2856 | C nucleon-nucleus / nucleus-nucleus interface to DPMJET | |
2857 | INTEGER IDEQP,IDEQB,IHFLD,IHFLS | |
2858 | DOUBLE PRECISION ECMN,PCMN,SECM,SPCM,XPSUB,XTSUB | |
2859 | COMMON /POHDFL/ ECMN,PCMN,SECM,SPCM,XPSUB,XTSUB, | |
2860 | & IDEQP(2),IDEQB(2),IHFLD(2,2),IHFLS(2) | |
2861 | C event weights and generated cross section | |
2862 | INTEGER IPOWGC,ISWCUT,IVWGHT | |
2863 | DOUBLE PRECISION SIGGEN,HSWGHT,HSWCUT,EVWGHT | |
2864 | COMMON /POWGHT/ SIGGEN(4),HSWGHT(0:10),HSWCUT(20),EVWGHT(0:10), | |
2865 | & IPOWGC(0:10),ISWCUT(20),IVWGHT(0:10) | |
2866 | ||
2867 | DIMENSION P1(4),P2(4) | |
2868 | ||
2869 | WRITE(LO,'(//1X,A,I10)') 'PHO_GPHERA: events to process',NEVENT | |
2870 | C assign particle momenta according to HERA kinematics | |
2871 | C proton data | |
2872 | PROM = PHO_PMASS(2212,1) | |
2873 | PROM2 = PROM**2 | |
2874 | IDPSRC(1) = 0 | |
2875 | IDBSRC(1) = 0 | |
2876 | C electron data | |
2877 | ELEM = 0.512D-03 | |
2878 | ELEM2 = ELEM**2 | |
2879 | AMSRC(2) = ELEM | |
2880 | IDPSRC(2) = 11 | |
2881 | IDBSRC(2) = ipho_pdg2id(11) | |
2882 | C | |
2883 | Q2MIN = Q2MIN2 | |
2884 | Q2MAX = Q2MAX2 | |
2885 | C | |
2886 | XIMAX = LOG(YMAX2) | |
2887 | XIMIN = LOG(YMIN2) | |
2888 | XIDEL = XIMAX-XIMIN | |
2889 | C | |
2890 | IF(Q2MIN.GT.ELEM2*YMIN2**2/(1.D0-YMIN2)) | |
2891 | & WRITE(LO,'(/1X,A,1P2E11.4)') | |
2892 | & 'PHO_GPHERA: lower Q2 cutoff larger than kin. limit:', | |
2893 | & Q2MIN,ELEM2*YMIN2**2/(1.D0-YMIN2) | |
2894 | C | |
2895 | Max_tab = 50 | |
2896 | DELLY = LOG(YMAX2/YMIN2)/DBLE(Max_tab-1) | |
2897 | FLUXT = 0.D0 | |
2898 | FLUXL = 0.D0 | |
2899 | IF(IDEB(30).GE.1) WRITE(LO,'(1X,A,I5)') | |
2900 | & 'PHO_GPHERA: table of photon flux (trans/long)',Max_tab | |
2901 | DO 100 I=1,Max_tab | |
2902 | Y = EXP(XIMIN+DELLY*DBLE(I-1)) | |
2903 | Q2LOW = MAX(Q2MIN,ELEM2*Y**2/(1.D0-Y)) | |
2904 | FFT = ((1.D0+(1.D0-Y)**2)/Y*LOG(Q2MAX/Q2LOW) | |
2905 | & -2.D0*ELEM2*Y*(1.D0/Q2LOW-1.D0/Q2MAX))/(2.D0*PI*137.D0) | |
2906 | FFL = 2.D0*(1.D0-Y)/Y*LOG(Q2MAX/Q2LOW)/(2.D0*PI*137.D0) | |
2907 | FLUXT = FLUXT + Y*FFT | |
2908 | FLUXL = FLUXL + Y*FFL | |
2909 | IF(IDEB(30).GE.1) WRITE(LO,'(5X,1P3E14.4)') Y,FFT,FFL | |
2910 | 100 CONTINUE | |
2911 | FLUXT = FLUXT*DELLY | |
2912 | FLUXL = FLUXL*DELLY | |
2913 | IF(IDEB(30).GE.1) WRITE(LO,'(1X,A,1P2E12.4)') | |
2914 | & 'PHO_GPHERA: integrated flux (trans./long.):',FLUXT,FLUXL | |
2915 | C | |
2916 | AY = 0.D0 | |
2917 | AY2 = 0.D0 | |
2918 | YY = YMIN2 | |
2919 | Q2LOW = MAX(Q2MIN,ELEM2*YY**2/(1.D0-YY)) | |
2920 | WGMAX = (1.D0+(1.D0-YY)**2)*LOG(Q2MAX/Q2LOW) | |
2921 | & -2.D0*ELEM2*YY*(1.D0/Q2LOW-1.D0/Q2MAX)*YY | |
2922 | IF(ISWMDL(10).GE.2) WGMAX = WGMAX+2.D0*(1.D0-YY)*LOG(Q2MAX/Q2LOW) | |
2923 | C | |
2924 | C initialization of PHOJET at upper energy limit | |
2925 | C proton momentum | |
2926 | P1(1) = 0.D0 | |
2927 | P1(2) = 0.D0 | |
2928 | P1(3) = SQRT(EE1**2-PROM2+DEPS) | |
2929 | P1(4) = EE1 | |
2930 | C photon momentum | |
2931 | EGAM = YMAX2*EE2 | |
2932 | P2(1) = 0.D0 | |
2933 | P2(2) = 0.D0 | |
2934 | P2(3) = -EGAM | |
2935 | P2(4) = EGAM | |
2936 | C sum of both photon polarizations | |
2937 | IGHEL(2) = -1 | |
2938 | C | |
2939 | CALL PHO_SETPAR(1,2212,0,0.D0) | |
2940 | CALL PHO_SETPAR(2,22,0,0.D0) | |
2941 | CALL PHO_EVENT(-1,P1,P2,SIGMAX,IREJ) | |
2942 | CALL PHO_PHIST(-1,SIGMAX) | |
2943 | CALL PHO_LHIST(-1,SIGMAX) | |
2944 | C | |
2945 | C generation of events, flux calculation | |
2946 | ECMIN2 = ECMIN**2 | |
2947 | ECMAX2 = ECMAX**2 | |
2948 | AY = 0.D0 | |
2949 | AY2 = 0.D0 | |
2950 | Q22MIN = 1.D30 | |
2951 | Q22AVE = 0.D0 | |
2952 | Q22AV2 = 0.D0 | |
2953 | Q22MAX = 0.D0 | |
2954 | AN2MIN = 1.D30 | |
2955 | AN2MAX = 0.D0 | |
2956 | YY2MIN = 1.D30 | |
2957 | YY2MAX = 0.D0 | |
2958 | NITER = NEVENT | |
2959 | ITRY = 0 | |
2960 | ITRW = 0 | |
2961 | DO 200 I=1,NITER | |
2962 | 150 CONTINUE | |
2963 | C sample y | |
2964 | ITRY = ITRY+1 | |
2965 | 175 CONTINUE | |
2966 | ITRW = ITRW+1 | |
2967 | YY = EXP(XIDEL*DT_RNDM(AY)+XIMIN) | |
2968 | IF(ISWMDL(10).GE.2) THEN | |
2969 | YEFF = 1.D0+(1.D0-YY)**2+2.D0*(1.D0-YY) | |
2970 | ELSE | |
2971 | YEFF = 1.D0+(1.D0-YY)**2 | |
2972 | ENDIF | |
2973 | Q2LOW = MAX(Q2MIN,ELEM2*YY**2/(1.D0-YY)) | |
2974 | Q2LOG = LOG(Q2MAX/Q2LOW) | |
2975 | WGH = YEFF*Q2LOG-2.D0*ELEM2*YY**2*(1.D0/Q2LOW-1.D0/Q2MAX) | |
2976 | IF(WGMAX.LT.WGH) THEN | |
2977 | WRITE(LO,'(1X,A,3E12.5)') | |
2978 | & 'PHO_GPHERA: inconsistent weight:',YY,WGMAX,WGH | |
2979 | ENDIF | |
2980 | IF(DT_RNDM(AY2)*WGMAX.GT.WGH) GOTO 175 | |
2981 | C sample Q2 | |
2982 | IF(IPAMDL(174).EQ.1) THEN | |
2983 | 185 CONTINUE | |
2984 | Q2 = Q2LOW*EXP(Q2LOG*DT_RNDM(YY)) | |
2985 | WEIGHT = (YEFF-2.D0*ELEM2*YY**2/Q2)/YEFF | |
2986 | IF(WEIGHT.LT.DT_RNDM(Q2)) GOTO 185 | |
2987 | ELSE | |
2988 | Q2 = Q2LOW | |
2989 | ENDIF | |
2990 | C | |
2991 | C incoming electron | |
2992 | PINI(1,2) = 0.D0 | |
2993 | PINI(2,2) = 0.D0 | |
2994 | PINI(3,2) = -EE2 | |
2995 | PINI(4,2) = EE2 | |
2996 | PINI(5,2) = 0.D0 | |
2997 | C outgoing electron | |
2998 | YQ2 = SQRT((1.D0-YY)*Q2) | |
2999 | Q2E = Q2/(4.D0*EE2) | |
3000 | E1Y = EE2*(1.D0-YY) | |
3001 | CALL PHO_SFECFE(SIF,COF) | |
3002 | PFIN(1,2) = YQ2*COF | |
3003 | PFIN(2,2) = YQ2*SIF | |
3004 | PFIN(3,2) = -E1Y+Q2E | |
3005 | PFIN(4,2) = E1Y+Q2E | |
3006 | PFIN(5,2) = 0.D0 | |
3007 | C set /POFSRC/ | |
3008 | GYY(2) = YY | |
3009 | GQ2(2) = Q2 | |
3010 | C polar angle | |
3011 | PFTHE(2) = ACOS(PFIN(3,2)/PFIN(4,2)) | |
3012 | C electron tagger | |
3013 | IF(PFIN(4,2).GT.EEMIN2) THEN | |
3014 | IF((PFTHE(2).LT.THMIN2).OR.(PFTHE(2).GT.THMAX2)) GOTO 175 | |
3015 | ENDIF | |
3016 | C azimuthal angle | |
3017 | PFPHI(2) = ATAN2(COF,SIF) | |
3018 | C photon momentum | |
3019 | P2(1) = -PFIN(1,2) | |
3020 | P2(2) = -PFIN(2,2) | |
3021 | P2(3) = PINI(3,2)-PFIN(3,2) | |
3022 | P2(4) = PINI(4,2)-PFIN(4,2) | |
3023 | C proton momentum | |
3024 | P1(1) = 0.D0 | |
3025 | P1(2) = 0.D0 | |
3026 | P1(3) = SQRT(EE1**2-PROM2) | |
3027 | P1(4) = EE1 | |
3028 | C ECMS cut | |
3029 | GGECM = (P1(4)+P2(4))**2-(P1(1)+P2(1))**2 | |
3030 | & -(P1(2)+P2(2))**2-(P1(3)+P2(3))**2 | |
3031 | IF((GGECM.LT.ECMIN2).OR.(GGECM.GT.ECMAX2)) GOTO 175 | |
3032 | GGECM = SQRT(GGECM) | |
3033 | C | |
3034 | PGAM(1,2) = P2(1) | |
3035 | PGAM(2,2) = P2(2) | |
3036 | PGAM(3,2) = P2(3) | |
3037 | PGAM(4,2) = P2(4) | |
3038 | PGAM(5,2) = -SQRT(Q2) | |
3039 | C photon helicity | |
3040 | IF(ISWMDL(10).GE.2) THEN | |
3041 | WGH = YEFF-2.D0*ELEM2*YY**2/Q2 | |
3042 | WGHL = 2.D0*(1-YY) | |
3043 | IF(DT_RNDM(YY).GE.WGHL/WGH) THEN | |
3044 | IGHEL(2) = 1 | |
3045 | ELSE | |
3046 | IGHEL(2) = 0 | |
3047 | ENDIF | |
3048 | ELSE | |
3049 | IGHEL(2) = -1 | |
3050 | ENDIF | |
3051 | C user cuts | |
3052 | CALL PHO_PRESEL(5,IREJ) | |
3053 | IF(IREJ.NE.0) GOTO 175 | |
3054 | C event generation | |
3055 | CALL PHO_EVENT(1,P1,P2,SIGCUR,IREJ) | |
3056 | IF(IREJ.NE.0) GOTO 150 | |
3057 | C statistics | |
3058 | AY = AY+YY | |
3059 | AY2 = AY2+YY*YY | |
3060 | YY2MIN = MIN(YY2MIN,YY) | |
3061 | YY2MAX = MAX(YY2MAX,YY) | |
3062 | Q22MIN = MIN(Q22MIN,Q2) | |
3063 | Q22MAX = MAX(Q22MAX,Q2) | |
3064 | Q22AVE = Q22AVE+Q2 | |
3065 | Q22AV2 = Q22AV2+Q2*Q2 | |
3066 | AN2MIN = MIN(AN2MIN,PFTHE(2)) | |
3067 | AN2MAX = MAX(AN2MAX,PFTHE(2)) | |
3068 | C histograms | |
3069 | CALL PHO_PHIST(1,HSWGHT(0)) | |
3070 | CALL PHO_LHIST(1,HSWGHT(0)) | |
3071 | 200 CONTINUE | |
3072 | C | |
3073 | WGY = WGMAX*DBLE(ITRY)/DBLE(ITRW)/(137.D0*2.D0*PI) | |
3074 | WGY = WGY*LOG(YMAX2/YMIN2) | |
3075 | AY = AY/DBLE(NITER) | |
3076 | AY2 = AY2/DBLE(NITER) | |
3077 | DAY = SQRT((AY2-AY**2)/DBLE(NITER)) | |
3078 | Q22AVE = Q22AVE/DBLE(NITER) | |
3079 | Q22AV2 = Q22AV2/DBLE(NITER) | |
3080 | Q22AV2 = SQRT((Q22AV2-Q22AVE**2)/DBLE(NITER)) | |
3081 | WEIGHT = WGY*SIGMAX*DBLE(NITER)/DBLE(ITRY) | |
3082 | C output of histograms | |
3083 | WRITE(LO,'(//1X,A,/1X,A,1PE12.3,A,/1X,A)') | |
3084 | &'=========================================================', | |
3085 | &' ***** simulated cross section: ',WEIGHT,' mb *****', | |
3086 | &'=========================================================' | |
3087 | WRITE(LO,'(//1X,A,3I10)') | |
3088 | & 'PHO_GPHERA:SUMMARY:NITER,ITRY,ITRW',NITER,ITRY,ITRW | |
3089 | WRITE(LO,'(1X,A,1P2E12.4)') 'EFFECTIVE WEIGHT (FLUX,TOTAL)', | |
3090 | & WGY,WEIGHT | |
3091 | WRITE(LO,'(1X,A,1P2E12.4)') 'AVERAGE Y,DY ',AY,DAY | |
3092 | WRITE(LO,'(1X,A,1P2E12.4)') 'SAMPLED Y RANGE PHOTON ', | |
3093 | & YY2MIN,YY2MAX | |
3094 | WRITE(LO,'(1X,A,1P2E12.4)') 'AVERAGE Q2,DQ2 ', | |
3095 | & Q22AVE,Q22AV2 | |
3096 | WRITE(LO,'(1X,A,1P2E12.4)') 'SAMPLED Q2 RANGE PHOTON ', | |
3097 | & Q22MIN,Q22MAX | |
3098 | WRITE(LO,'(1X,A,1P4E12.4)') 'SAMPLED THETA RANGE ELECTRON ', | |
3099 | & AN2MIN,AN2MAX,PI-AN2MAX,PI-AN2MIN | |
3100 | C | |
3101 | CALL PHO_EVENT(-2,P1,P2,WEIGHT,IREJ) | |
3102 | IF(NITER.GT.1) THEN | |
3103 | CALL PHO_PHIST(-2,WEIGHT) | |
3104 | CALL PHO_LHIST(-2,WEIGHT) | |
3105 | ELSE | |
3106 | WRITE(LO,'(1X,A,I4)') 'PHO_GPHERA:NO OUTPUT OF HISTOGRAMS',NITER | |
3107 | ENDIF | |
3108 | ||
3109 | END | |
3110 | ||
3111 | *$ CREATE PHO_GGEPEM.FOR | |
3112 | *COPY PHO_GGEPEM | |
3113 | CDECK ID>, PHO_GGEPEM | |
3114 | SUBROUTINE PHO_GGEPEM(NEVENT,EE1,EE2) | |
3115 | C********************************************************************** | |
3116 | C | |
3117 | C interface to call PHOJET (variable energy run) for | |
3118 | C gamma-gamma collisions on e+e- collider | |
3119 | C | |
3120 | C fully differential equivalent (improved) photon approximation | |
3121 | C to get photon flux | |
3122 | C | |
3123 | C input: EE1 LAB system energy of electron/positron 1 | |
3124 | C EE2 LAB system energy of electron/positron 2 | |
3125 | C NEVENT >0 number of events to generate | |
3126 | C -1 initialization | |
3127 | C -2 final call (cross section calculation) | |
3128 | C from /LEPCUT/: | |
3129 | C YMIN1 lower limit of Y1 | |
3130 | C (energy fraction taken by photon from electron) | |
3131 | C YMAX1 upper limit of Y1 | |
3132 | C Q2MIN1 lower limit of photon virtuality | |
3133 | C Q2MAX1 upper limit of photon virtuality | |
3134 | C THMIN1 lower limit of scattered electron | |
3135 | C THMAX1 upper limit of scattered electron | |
3136 | C YMIN2 lower limit of Y2 | |
3137 | C (energy fraction taken by photon from electron) | |
3138 | C YMAX2 upper limit of Y2 | |
3139 | C Q2MIN2 lower limit of photon virtuality | |
3140 | C Q2MAX2 upper limit of photon virtuality | |
3141 | C THMIN2 lower limit of scattered electron | |
3142 | C THMAX2 upper limit of scattered electron | |
3143 | C | |
3144 | C output: after final call with NEVENT=-2 | |
3145 | C EE1 e+ e- cross section (mb) | |
3146 | C EE2 gamma-gamma cross section (mb) | |
3147 | C | |
3148 | C********************************************************************** | |
3149 | IMPLICIT NONE | |
3150 | SAVE | |
3151 | ||
3152 | DOUBLE PRECISION EE1,EE2 | |
3153 | INTEGER NEVENT | |
3154 | ||
3155 | C input/output channels | |
3156 | INTEGER LI,LO | |
3157 | COMMON /POINOU/ LI,LO | |
3158 | C event debugging information | |
3159 | INTEGER NMAXD | |
3160 | PARAMETER (NMAXD=100) | |
3161 | INTEGER IDEB,KSPOM,KHPOM,KSREG,KHDIR,KACCEP,KSTRG,KHTRG,KSLOO, | |
3162 | & KHLOO,KSDPO,KHDPO,KEVENT,KSOFT,KHARD | |
3163 | COMMON /PODEBG/ IDEB(NMAXD),KSPOM,KHPOM,KSREG,KHDIR,KACCEP,KSTRG, | |
3164 | & KHTRG,KSLOO,KHLOO,KSDPO,KHDPO,KEVENT,KSOFT,KHARD | |
3165 | C model switches and parameters | |
3166 | CHARACTER*8 MDLNA | |
3167 | INTEGER ISWMDL,IPAMDL | |
3168 | DOUBLE PRECISION PARMDL | |
3169 | COMMON /POMDLS/ MDLNA(50),ISWMDL(50),PARMDL(400),IPAMDL(400) | |
3170 | C some constants | |
3171 | DOUBLE PRECISION PI,PI2,PI4,GEV2MB,Q_ch,Q_ch2,Q_ch4 | |
3172 | COMMON /POCONS/ PI,PI2,PI4,GEV2MB, | |
3173 | & Q_ch(-6:6),Q_ch2(-6:6),Q_ch4(-6:6) | |
3174 | C photon flux kinematics and cuts | |
3175 | DOUBLE PRECISION ECMIN,ECMAX,EEMIN1,EEMIN2, | |
3176 | & YMIN1,YMAX1,YMIN2,YMAX2, | |
3177 | & Q2MIN1,Q2MAX1,Q2MIN2,Q2MAX2, | |
3178 | & THMIN1,THMAX1,THMIN2,THMAX2 | |
3179 | INTEGER ITAG1,ITAG2 | |
3180 | COMMON /POFCUT/ ECMIN,ECMAX,EEMIN1,EEMIN2, | |
3181 | & YMIN1,YMAX1,YMIN2,YMAX2, | |
3182 | & Q2MIN1,Q2MAX1,Q2MIN2,Q2MAX2, | |
3183 | & THMIN1,THMAX1,THMIN2,THMAX2, | |
3184 | & ITAG1,ITAG2 | |
3185 | C gamma-lepton or gamma-hadron vertex information | |
3186 | INTEGER IGHEL,IDPSRC,IDBSRC | |
3187 | DOUBLE PRECISION PINI,PFIN,PGAM,GYY,GQ2,GGECM,GAIMP,PFTHE,PFPHI, | |
3188 | & RADSRC,AMSRC,GAMSRC | |
3189 | COMMON /POFSRC/ PINI(5,2),PFIN(5,2),PGAM(5,2),IGHEL(2), | |
3190 | & GYY(2),GQ2(2),GGECM,GAIMP(2),PFTHE(2),PFPHI(2), | |
3191 | & IDPSRC(2),IDBSRC(2),RADSRC(2),AMSRC(2),GAMSRC(2) | |
3192 | C nucleon-nucleus / nucleus-nucleus interface to DPMJET | |
3193 | INTEGER IDEQP,IDEQB,IHFLD,IHFLS | |
3194 | DOUBLE PRECISION ECMN,PCMN,SECM,SPCM,XPSUB,XTSUB | |
3195 | COMMON /POHDFL/ ECMN,PCMN,SECM,SPCM,XPSUB,XTSUB, | |
3196 | & IDEQP(2),IDEQB(2),IHFLD(2,2),IHFLS(2) | |
3197 | C event weights and generated cross section | |
3198 | INTEGER IPOWGC,ISWCUT,IVWGHT | |
3199 | DOUBLE PRECISION SIGGEN,HSWGHT,HSWCUT,EVWGHT | |
3200 | COMMON /POWGHT/ SIGGEN(4),HSWGHT(0:10),HSWCUT(20),EVWGHT(0:10), | |
3201 | & IPOWGC(0:10),ISWCUT(20),IVWGHT(0:10) | |
3202 | ||
3203 | C external functions | |
3204 | DOUBLE PRECISION DT_RNDM | |
3205 | ||
3206 | C local variables | |
3207 | DOUBLE PRECISION AN1MAX,AN1MIN,AN2MAX,AN2MIN,AY1,AY2,AYS1,AYS2, | |
3208 | & COF1,COF2,CPFTHE,DAY1,DAY2,DELLY,DITRY,DITRW, | |
3209 | & ECFRAC,ECMAX2,ECMIN2,EGAM,ELEM,ELEM2,FFL,FFT,FLUXL,FLUXT, | |
3210 | & FLXAPP,FLXQPM,GGECM2,P1,P2,PP,PT,PT2,Q21AV2,Q21AVE,Q21MAX, | |
3211 | & Q21MIN,Q22AV2,Q22AVE,Q22MAX,Q22MIN,Q2LOG1,Q2LOG2,Q2LOW1, | |
3212 | & Q2LOW2,Q2P1,Q2P2,SIF1,SIF2,SIGCUR,SIGMAX,THMAC1, | |
3213 | & THMAC2,THMIC1,THMIC2,WEIGHT,WG,WGFX,WGH,WGHAPP,WGHL,WGHQPM, | |
3214 | & WGMAX,WGY,X1DEL,X1MAX,X1MIN,X2DEL,X2MAX,X2MIN,Y1,Y2,YEFF1,YEFF2, | |
3215 | & YMI,YY1MAX,YY1MIN,YY2MAX,YY2MIN | |
3216 | ||
3217 | INTEGER I,IHEAC1,IHEAC2,IHETRY,IREJ,ITRW_low,ITRW_high,ITRY_low, | |
3218 | & ITRY_high,K,Max_tab,NITER,ITG1,ITG2 | |
3219 | ||
3220 | DIMENSION P1(4),P2(4),IHETRY(4),IHEAC1(4),IHEAC2(4) | |
3221 | integer ipho_pdg2id | |
3222 | ||
3223 | C initialization of event generation | |
3224 | ||
3225 | if(NEVENT.eq.-1) then | |
3226 | ||
3227 | DO 10 I=1,4 | |
3228 | IHETRY(I) = 0 | |
3229 | IHEAC1(I) = 0 | |
3230 | IHEAC2(I) = 0 | |
3231 | 10 CONTINUE | |
3232 | ||
3233 | WRITE(LO,'(//1X,A)') 'PHO_GGEPEM: initialization' | |
3234 | ||
3235 | C electron data | |
3236 | ELEM = 0.512D-03 | |
3237 | ELEM2 = ELEM**2 | |
3238 | AMSRC(1) = ELEM | |
3239 | AMSRC(2) = ELEM | |
3240 | C lepton numbers | |
3241 | IDPSRC(1) = 11 | |
3242 | IDPSRC(2) = -11 | |
3243 | IDBSRC(1) = ipho_pdg2id(11) | |
3244 | IDBSRC(2) = ipho_pdg2id(-11) | |
3245 | ||
3246 | C check/update kinematic limitations | |
3247 | ||
3248 | Ymi = min(Ymax1,1.D0-ELEM/EE1) | |
3249 | if(Ymi.lt.Ymax1) then | |
3250 | WRITE(LO,'(/1X,A,2E12.5)') | |
3251 | & 'PHO_GGEPEM: Ymax1 decreased (old/new)',Ymax1,Ymi | |
3252 | Ymax1 = YMI | |
3253 | endif | |
3254 | Ymi = min(Ymax2,1.D0-ELEM/EE2) | |
3255 | if(Ymi.lt.Ymax2) then | |
3256 | WRITE(LO,'(/1X,A,2E12.5)') | |
3257 | & 'PHO_GGEPEM: Ymax2 decreased (old/new)',Ymax2,Ymi | |
3258 | Ymax2 = YMI | |
3259 | endif | |
3260 | ||
3261 | YMI = ECMIN**2/(4.D0*EE1*EE2*YMAX2) | |
3262 | IF(YMIN1.LT.YMI) THEN | |
3263 | WRITE(LO,'(/1X,A,2E12.5)') | |
3264 | & 'PHO_GGEPEM: Ymin1 increased (old/new)',YMIN1,YMI | |
3265 | YMIN1 = YMI | |
3266 | ELSE IF(YMIN1.GT.YMI) THEN | |
3267 | WRITE(LO,'(/1X,A,/1X,A,E12.5,A,E12.5)') | |
3268 | & 'PHO_GGEPEM:','ECM-CUT corresponds to YMIN1 of',YMI, | |
3269 | & ' INSTEAD OF',YMIN1 | |
3270 | ENDIF | |
3271 | YMI = ECMIN**2/(4.D0*EE1*EE2*YMAX1) | |
3272 | IF(YMIN2.LT.YMI) THEN | |
3273 | WRITE(LO,'(/1X,A,2E12.5)') | |
3274 | & 'PHO_GGEPEM: Ymin2 increased (old/new)',YMIN2,YMI | |
3275 | YMIN2 = YMI | |
3276 | ELSE IF(YMIN2.GT.YMI) THEN | |
3277 | WRITE(LO,'(/1X,A,/1X,A,E12.5,A,E12.5)') | |
3278 | & 'PHO_GGEPEM:','ECM-CUT corresponds to YMIN2 of',YMI, | |
3279 | & ' INSTEAD OF',YMIN2 | |
3280 | ENDIF | |
3281 | ||
3282 | C store COS of angular tagging range | |
3283 | THMIC1 = COS(MAX(0.D0,THMIN1)) | |
3284 | THMAC1 = COS(MIN(THMAX1,PI)) | |
3285 | THMIC2 = COS(MAX(0.D0,THMIN2)) | |
3286 | THMAC2 = COS(MIN(THMAX2,PI)) | |
3287 | ||
3288 | X1MAX = LOG(YMAX1) | |
3289 | X1MIN = LOG(YMIN1) | |
3290 | X1DEL = X1MAX-X1MIN | |
3291 | X2MAX = LOG(YMAX2) | |
3292 | X2MIN = LOG(YMIN2) | |
3293 | X2DEL = X2MAX-X2MIN | |
3294 | ||
3295 | C debug: integrated photon flux | |
3296 | ||
3297 | if(IDEB(30).ge.1) then | |
3298 | Max_tab = 50 | |
3299 | FLUXT = 0.D0 | |
3300 | FLUXL = 0.D0 | |
3301 | DELLY = LOG(YMAX1/YMIN1)/DBLE(Max_tab-1) | |
3302 | IF(IDEB(30).GE.2) WRITE(LO,'(1X,2A,I5)') 'PHO_GGEPEM: ', | |
3303 | & 'table of photon flux (trans/long side 1)',Max_tab | |
3304 | do I=1,Max_tab | |
3305 | Y1 = EXP(X1MIN+DELLY*DBLE(I-1)) | |
3306 | if((1.D0-Y1).gt.1.D-8) then | |
3307 | Q2LOW1 = MAX(Q2MIN1,ELEM2*Y1*Y1/(1.D0-Y1)) | |
3308 | else | |
3309 | Q2low1 = 2.D0*Q2max1 | |
3310 | endif | |
3311 | if(Q2low1.lt.Q2max1) then | |
3312 | FFT = ((1.D0+(1.D0-Y1)**2)/Y1*LOG(Q2MAX1/Q2LOW1) | |
3313 | & -2.D0*ELEM2*Y1*(1.D0/Q2LOW1-1.D0/Q2MAX1))/(2.D0*PI*137.D0) | |
3314 | FFL = 2.D0*(1.D0-Y1)*LOG(Q2MAX1/Q2LOW1)/(2.D0*PI*137.D0) | |
3315 | else | |
3316 | FFT = 0.D0 | |
3317 | FFL = 0.D0 | |
3318 | endif | |
3319 | FLUXT = FLUXT + Y1*FFL | |
3320 | FLUXL = FLUXL + Y1*FFT | |
3321 | IF(IDEB(30).GE.2) WRITE(LO,'(5X,1P3E14.4)') Y1,FFT,FFL | |
3322 | enddo | |
3323 | FLUXT = FLUXT*DELLY | |
3324 | FLUXL = FLUXL*DELLY | |
3325 | WRITE(LO,'(1X,2A,1P2E12.4)') 'PHO_GGEPEM: ', | |
3326 | & 'integrated flux (trans/long side 1):',FLUXT,FLUXL | |
3327 | endif | |
3328 | ||
3329 | C maximum weight | |
3330 | ||
3331 | Q2LOW1 = MAX(Q2MIN1,ELEM2*YMIN1**2/(1.D0-YMIN1)) | |
3332 | Q2LOW2 = MAX(Q2MIN2,ELEM2*YMIN2**2/(1.D0-YMIN2)) | |
3333 | Y1 = YMIN1 | |
3334 | Y2 = YMIN2 | |
3335 | IF(ISWMDL(10).GE.2) THEN | |
3336 | C long. and transversely polarized photons | |
3337 | WGMAX = ((1.D0+(1.D0-Y1)**2+2.D0*(1.D0-Y1))*LOG(Q2MAX1/Q2LOW1) | |
3338 | & -2.D0*ELEM2*Y1*(1.D0/Q2LOW1-1.D0/Q2MAX1)*Y1) | |
3339 | & *((1.D0+(1.D0-Y2)**2+2.D0*(1.D0-Y2))*LOG(Q2MAX2/Q2LOW2) | |
3340 | & -2.D0*ELEM2*Y2*(1.D0/Q2LOW2-1.D0/Q2MAX2)*Y2) | |
3341 | ELSE | |
3342 | C transversely polarized photons only | |
3343 | WGMAX = ((1.D0+(1.D0-Y1)**2)*LOG(Q2MAX1/Q2LOW1) | |
3344 | & -2.D0*ELEM2*Y1*(1.D0/Q2LOW1-1.D0/Q2MAX1)*Y1) | |
3345 | & *((1.D0+(1.D0-Y2)**2)*LOG(Q2MAX2/Q2LOW2) | |
3346 | & -2.D0*ELEM2*Y2*(1.D0/Q2LOW2-1.D0/Q2MAX2)*Y2) | |
3347 | ENDIF | |
3348 | ||
3349 | C initialize gamma-gamma event generator | |
3350 | ||
3351 | C photon 1 | |
3352 | EGAM = YMAX1*EE1 | |
3353 | P1(1) = 0.D0 | |
3354 | P1(2) = 0.D0 | |
3355 | P1(3) = SQRT(EGAM**2-Q2LOW1) | |
3356 | P1(4) = EGAM | |
3357 | C photon 2 | |
3358 | EGAM = YMAX2*EE2 | |
3359 | P2(1) = 0.D0 | |
3360 | P2(2) = 0.D0 | |
3361 | P2(3) = -SQRT(EGAM**2-Q2LOW2) | |
3362 | P2(4) = EGAM | |
3363 | C sum of helicities | |
3364 | IGHEL(1) = -1 | |
3365 | IGHEL(2) = -1 | |
3366 | ||
3367 | C set min. energy for interpolation tables | |
3368 | parmdl(19) = min(parmdl(19),ecmin) | |
3369 | ||
3370 | C initialize event gneration | |
3371 | CALL PHO_SETPAR(1,22,0,0.D0) | |
3372 | CALL PHO_SETPAR(2,22,0,0.D0) | |
3373 | CALL PHO_EVENT(-1,P1,P2,SIGMAX,IREJ) | |
3374 | CALL PHO_PHIST(-1,SIGMAX) | |
3375 | CALL PHO_LHIST(-1,SIGMAX) | |
3376 | ||
3377 | C generation of events, flux calculation | |
3378 | ECMIN2 = ECMIN**2 | |
3379 | ECMAX2 = ECMAX**2 | |
3380 | ECFRAC = ECMIN2/(4.D0*EE1*EE2) | |
3381 | AY1 = 0.D0 | |
3382 | AY2 = 0.D0 | |
3383 | AYS1 = 0.D0 | |
3384 | AYS2 = 0.D0 | |
3385 | Q21MIN = 1.D30 | |
3386 | Q22MIN = 1.D30 | |
3387 | Q21MAX = 0.D0 | |
3388 | Q22MAX = 0.D0 | |
3389 | Q21AVE = 0.D0 | |
3390 | Q22AVE = 0.D0 | |
3391 | Q21AV2 = 0.D0 | |
3392 | Q22AV2 = 0.D0 | |
3393 | AN1MIN = 1.D30 | |
3394 | AN2MIN = 1.D30 | |
3395 | AN1MAX = 0.D0 | |
3396 | AN2MAX = 0.D0 | |
3397 | YY1MIN = 1.D30 | |
3398 | YY2MIN = 1.D30 | |
3399 | YY1MAX = 0.D0 | |
3400 | YY2MAX = 0.D0 | |
3401 | NITER = 0 | |
3402 | ITRY_low = 0 | |
3403 | ITRY_high = 0 | |
3404 | ITRW_low = 0 | |
3405 | ITRW_high = 0 | |
3406 | ||
3407 | C generate NEVENT events (might be just 1 per call) | |
3408 | ||
3409 | else if(NEVENT.gt.0) then | |
3410 | ||
3411 | NITER = NITER+NEVENT | |
3412 | ||
3413 | DO 200 I=1,NEVENT | |
3414 | ||
3415 | C sample y1, y2 | |
3416 | 150 CONTINUE | |
3417 | ITRY_low = ITRY_low+1 | |
3418 | if(ITRY_low.eq.1000000) then | |
3419 | ITRY_low = 0 | |
3420 | ITRY_high = ITRY_high+1 | |
3421 | endif | |
3422 | ||
3423 | 175 CONTINUE | |
3424 | ITRW_low = ITRW_low+1 | |
3425 | if(ITRW_low.eq.1000000) then | |
3426 | ITRW_low = 0 | |
3427 | ITRW_high = ITRW_high+1 | |
3428 | endif | |
3429 | ||
3430 | Y1 = EXP(X1DEL*DT_RNDM(AY1)+X1MIN) | |
3431 | Y2 = EXP(X2DEL*DT_RNDM(AY2)+X2MIN) | |
3432 | IF(Y1*Y2.LT.ECFRAC) GOTO 175 | |
3433 | IF(ISWMDL(10).GE.2) THEN | |
3434 | YEFF1 = 1.D0+(1.D0-Y1)**2+2.D0*(1.D0-Y1) | |
3435 | YEFF2 = 1.D0+(1.D0-Y2)**2+2.D0*(1.D0-Y2) | |
3436 | ELSE | |
3437 | YEFF1 = 1.D0+(1.D0-Y1)**2 | |
3438 | YEFF2 = 1.D0+(1.D0-Y2)**2 | |
3439 | ENDIF | |
3440 | ||
3441 | Q2LOW1 = MAX(Q2MIN1,ELEM2*Y1**2/(1.D0-Y1)) | |
3442 | Q2LOW2 = MAX(Q2MIN2,ELEM2*Y2**2/(1.D0-Y2)) | |
3443 | Q2LOG1 = LOG(Q2MAX1/Q2LOW1) | |
3444 | Q2LOG2 = LOG(Q2MAX2/Q2LOW2) | |
3445 | WGH = (YEFF1*Q2LOG1 | |
3446 | & -2.D0*ELEM2*Y1*(1.D0/Q2LOW1-1.D0/Q2MAX1)*Y1) | |
3447 | & *(YEFF2*Q2LOG2 | |
3448 | & -2.D0*ELEM2*Y2*(1.D0/Q2LOW2-1.D0/Q2MAX2)*Y2) | |
3449 | IF(WGMAX.LT.WGH) THEN | |
3450 | WRITE(LO,'(1X,A,4E12.5)') | |
3451 | & 'PHO_GGEPEM: inconsistent weight:',Y1,Y2,WGMAX,WGH | |
3452 | ENDIF | |
3453 | IF(DT_RNDM(AYS1)*WGMAX.GT.WGH) GOTO 175 | |
3454 | ||
3455 | C limit on Ecm_gg (app. cut, precise cut applied later) | |
3456 | GGECM2 = 4.D0*Y1*Y2*EE1*EE2 | |
3457 | if(GGECM2.lt.ECMIN2) goto 175 | |
3458 | ||
3459 | C sample Q2 | |
3460 | IF(IPAMDL(174).EQ.1) THEN | |
3461 | 185 CONTINUE | |
3462 | Q2P1 = Q2LOW1*EXP(Q2LOG1*DT_RNDM(Y1)) | |
3463 | WEIGHT = (YEFF1-2.D0*(1.D0-Y1)*Q2LOW1/Q2P1)/YEFF1 | |
3464 | IF(WEIGHT.LT.DT_RNDM(Q2P1)) GOTO 185 | |
3465 | ELSE | |
3466 | Q2P1 = Q2LOW1 | |
3467 | ENDIF | |
3468 | ||
3469 | IF(IPAMDL(174).EQ.1) THEN | |
3470 | 186 CONTINUE | |
3471 | Q2P2 = Q2LOW2*EXP(Q2LOG2*DT_RNDM(Y2)) | |
3472 | WEIGHT = (YEFF2-2.D0*(1.D0-Y2)*Q2LOW2/Q2P2)/YEFF2 | |
3473 | IF(WEIGHT.LT.DT_RNDM(Q2P2)) GOTO 186 | |
3474 | ELSE | |
3475 | Q2P2 = Q2LOW2 | |
3476 | ENDIF | |
3477 | ||
3478 | GYY(1) = Y1 | |
3479 | GQ2(1) = Q2P1 | |
3480 | GYY(2) = Y2 | |
3481 | GQ2(2) = Q2P2 | |
3482 | ||
3483 | C incoming electron 1 | |
3484 | PINI(1,1) = 0.D0 | |
3485 | PINI(2,1) = 0.D0 | |
3486 | PINI(3,1) = EE1*(1.D0-0.5D0*ELEM2/EE1**2) | |
3487 | PINI(4,1) = EE1 | |
3488 | PINI(5,1) = ELEM | |
3489 | C photon 1 | |
3490 | PP = (2.D0*EE1**2*Y1+Q2P1)/(2.D0*PINI(3,1)) | |
3491 | PT2 = (EE1**2*(Q2P1*(1.D0-Y1)-ELEM2*Y1**2) | |
3492 | & -0.25D0*Q2P1**2-Q2P1*ELEM2)/PINI(3,1)**2 | |
3493 | IF(PT2.LT.0.D0) GOTO 175 | |
3494 | PT = SQRT(PT2) | |
3495 | CALL PHO_SFECFE(SIF1,COF1) | |
3496 | P1(1) = COF1*PT | |
3497 | P1(2) = SIF1*PT | |
3498 | P1(3) = PP | |
3499 | P1(4) = EE1*Y1 | |
3500 | C outgoing electron 1 | |
3501 | PFIN(1,1) = -P1(1) | |
3502 | PFIN(2,1) = -P1(2) | |
3503 | PFIN(3,1) = PINI(3,1)-P1(3) | |
3504 | PFIN(4,1) = PINI(4,1)-P1(4) | |
3505 | PFIN(5,1) = ELEM | |
3506 | C incoming electron 2 | |
3507 | PINI(1,2) = 0.D0 | |
3508 | PINI(2,2) = 0.D0 | |
3509 | PINI(3,2) = -EE2*(1.D0-0.5D0*ELEM2/EE2**2) | |
3510 | PINI(4,2) = EE2 | |
3511 | PINI(5,2) = 0.D0 | |
3512 | C photon 2 | |
3513 | PP = (2.D0*EE2**2*Y2+Q2P2)/(2.D0*PINI(3,2)) | |
3514 | PT2 = (EE2**2*(Q2P2*(1.D0-Y2)-ELEM2*Y2**2) | |
3515 | & -0.25D0*Q2P2**2-Q2P2*ELEM2)/PINI(3,2)**2 | |
3516 | IF(PT2.LT.0.D0) GOTO 175 | |
3517 | PT = SQRT(PT2) | |
3518 | CALL PHO_SFECFE(SIF2,COF2) | |
3519 | P2(1) = COF2*PT | |
3520 | P2(2) = SIF2*PT | |
3521 | P2(3) = PP | |
3522 | P2(4) = EE2*Y2 | |
3523 | C outgoing electron 2 | |
3524 | PFIN(1,2) = -P2(1) | |
3525 | PFIN(2,2) = -P2(2) | |
3526 | PFIN(3,2) = PINI(3,2)-P2(3) | |
3527 | PFIN(4,2) = PINI(4,2)-P2(4) | |
3528 | PFIN(5,2) = ELEM | |
3529 | ||
3530 | C precise ECMS cut | |
3531 | ||
3532 | GGECM2 = (P1(4)+P2(4))**2-(P1(1)+P2(1))**2 | |
3533 | & -(P1(2)+P2(2))**2-(P1(3)+P2(3))**2 | |
3534 | IF((GGECM2.LT.ECMIN2).OR.(GGECM2.GT.ECMAX2)) GOTO 175 | |
3535 | GGECM = SQRT(GGECM2) | |
3536 | ||
3537 | C beam lepton detector acceptance | |
3538 | ||
3539 | C lepton tagger 1 | |
3540 | CPFTHE = PFIN(3,1)/PFIN(4,1) | |
3541 | ITG1 = 0 | |
3542 | IF(PFIN(4,1).GE.EEMIN1) THEN | |
3543 | IF((CPFTHE.LE.THMIC1).AND.(CPFTHE.GE.THMAC1)) ITG1 = 1 | |
3544 | ENDIF | |
3545 | ||
3546 | C lepton tagger 2 | |
3547 | CPFTHE = PFIN(3,2)/PFIN(4,2) | |
3548 | ITG2 = 0 | |
3549 | IF(PFIN(4,2).GE.EEMIN2) THEN | |
3550 | IF((CPFTHE.LE.THMIC2).AND.(CPFTHE.GE.THMAC2)) ITG2 = 1 | |
3551 | ENDIF | |
3552 | ||
3553 | C beam lepton taggers | |
3554 | ||
3555 | C anti-tag | |
3556 | IF((ITAG1.EQ.-1).AND.(ITG1.NE.0)) GOTO 175 | |
3557 | IF((ITAG2.EQ.-1).AND.(ITG2.NE.0)) GOTO 175 | |
3558 | C tag | |
3559 | IF((ITAG1.EQ.1).AND.(ITG1.EQ.0)) GOTO 175 | |
3560 | IF((ITAG2.EQ.1).AND.(ITG2.EQ.0)) GOTO 175 | |
3561 | C single-tag inclusive | |
3562 | IF((ITAG1.EQ.0).AND.(ITAG2.EQ.0).AND.(ITG1+ITG2.EQ.0)) | |
3563 | & GOTO 175 | |
3564 | C single-tag/anti-tag | |
3565 | IF((ITAG1.EQ.2).AND.(ITAG2.EQ.2).AND.(ITG1+ITG2.NE.1)) | |
3566 | & GOTO 175 | |
3567 | ||
3568 | PGAM(1,1) = P1(1) | |
3569 | PGAM(2,1) = P1(2) | |
3570 | PGAM(3,1) = P1(3) | |
3571 | PGAM(4,1) = P1(4) | |
3572 | PGAM(5,1) = -SQRT(Q2P1) | |
3573 | PGAM(1,2) = P2(1) | |
3574 | PGAM(2,2) = P2(2) | |
3575 | PGAM(3,2) = P2(3) | |
3576 | PGAM(4,2) = P2(4) | |
3577 | PGAM(5,2) = -SQRT(Q2P2) | |
3578 | ||
3579 | C photon helicities | |
3580 | IF(ISWMDL(10).GE.2) THEN | |
3581 | WGH = YEFF1-2.D0*ELEM2*Y1**2/Q2P1 | |
3582 | WGHL = 2.D0*(1-Y1) | |
3583 | IF(DT_RNDM(Y1).GT.WGHL/WGH) THEN | |
3584 | IGHEL(1) = 1 | |
3585 | ELSE | |
3586 | IGHEL(1) = 0 | |
3587 | ENDIF | |
3588 | WGH = YEFF2-2.D0*ELEM2*Y2**2/Q2P2 | |
3589 | WGHL = 2.D0*(1-Y2) | |
3590 | IF(DT_RNDM(Y2).GT.WGHL/WGH) THEN | |
3591 | IGHEL(2) = 1 | |
3592 | ELSE | |
3593 | IGHEL(2) = 0 | |
3594 | ENDIF | |
3595 | K = 2*IGHEL(1)+IGHEL(2)+1 | |
3596 | IHETRY(K) = IHETRY(K)+1 | |
3597 | ELSE | |
3598 | IGHEL(1) = -1 | |
3599 | IGHEL(2) = -1 | |
3600 | ENDIF | |
3601 | ||
3602 | C user cuts | |
3603 | CALL PHO_PRESEL(5,IREJ) | |
3604 | IF(IREJ.NE.0) GOTO 175 | |
3605 | ||
3606 | WGFX = 1.D0 | |
3607 | C reweight according to LO photon emission diagrams (Budnev et al.) | |
3608 | IF(IPAMDL(116).GE.1) THEN | |
3609 | CALL PHO_WGEPEM(FLXAPP,FLXQPM,0) | |
3610 | WGFX = FLXQPM/FLXAPP | |
3611 | if(WGFX.gt.1.D0) then | |
3612 | WRITE(LO,'(1x,a,/,5x,1p,5e11.4)') | |
3613 | & ' PHO_GGEPEM: flux weight > 1 (y1/2,Q21/2,W)', | |
3614 | & Y1,Y2,Q2P1,Q2P2,GGECM | |
3615 | endif | |
3616 | ENDIF | |
3617 | ||
3618 | C event generation | |
3619 | * IVWGHT(1) = 1 | |
3620 | * EVWGHT(1) = MAX(WGFX,1.D0) | |
3621 | CALL PHO_EVENT(1,P1,P2,SIGCUR,IREJ) | |
3622 | IF(IREJ.NE.0) GOTO 150 | |
3623 | IF(ISWMDL(10).GE.2) THEN | |
3624 | K = 2*IGHEL(1)+IGHEL(2)+1 | |
3625 | IHEAC1(K) = IHEAC1(K)+1 | |
3626 | ENDIF | |
3627 | ||
3628 | C reweight according to QPM model (e+e- collider only) | |
3629 | IF((KHDIR.GT.0).AND. | |
3630 | & (IPAMDL(116).GE.2).AND.(ISWMDL(10).GE.2)) THEN | |
3631 | CALL PHO_WGEPEM(WGHAPP,WGHQPM,1) | |
3632 | WG = WGHQPM/WGHAPP/MAX(1.D0,WGFX) | |
3633 | IF(DT_RNDM(WG).GT.WG) GOTO 150 | |
3634 | ELSE IF(IPAMDL(116).GE.1) THEN | |
3635 | IF(DT_RNDM(WG).GT.WGFX) GOTO 150 | |
3636 | ENDIF | |
3637 | ||
3638 | C polar angle | |
3639 | PFTHE(1) = ACOS(PFIN(3,1)/PFIN(4,1)) | |
3640 | PFTHE(2) = ACOS(PFIN(3,2)/PFIN(4,2)) | |
3641 | C azimuthal angle | |
3642 | PFPHI(1) = ATAN2(COF1,SIF1) | |
3643 | PFPHI(2) = ATAN2(COF2,SIF2) | |
3644 | ||
3645 | C statistics | |
3646 | AY1 = AY1+Y1 | |
3647 | AYS1 = AYS1+Y1*Y1 | |
3648 | AY2 = AY2+Y2 | |
3649 | AYS2 = AYS2+Y2*Y2 | |
3650 | Q21MIN = MIN(Q21MIN,Q2P1) | |
3651 | Q22MIN = MIN(Q22MIN,Q2P2) | |
3652 | Q21MAX = MAX(Q21MAX,Q2P1) | |
3653 | Q22MAX = MAX(Q22MAX,Q2P2) | |
3654 | AN1MIN = MIN(AN1MIN,PFTHE(1)) | |
3655 | AN2MIN = MIN(AN2MIN,PFTHE(2)) | |
3656 | AN1MAX = MAX(AN1MAX,PFTHE(1)) | |
3657 | AN2MAX = MAX(AN2MAX,PFTHE(2)) | |
3658 | YY1MIN = MIN(YY1MIN,Y1) | |
3659 | YY2MIN = MIN(YY2MIN,Y2) | |
3660 | YY1MAX = MAX(YY1MAX,Y1) | |
3661 | YY2MAX = MAX(YY2MAX,Y2) | |
3662 | Q21AVE = Q21AVE+Q2P1 | |
3663 | Q22AVE = Q22AVE+Q2P2 | |
3664 | Q21AV2 = Q21AV2+Q2P1*Q2P1 | |
3665 | Q22AV2 = Q22AV2+Q2P2*Q2P2 | |
3666 | IF(ISWMDL(10).GE.2) THEN | |
3667 | K = 2*IGHEL(1)+IGHEL(2)+1 | |
3668 | IHEAC2(K) = IHEAC2(K)+1 | |
3669 | ENDIF | |
3670 | C external histograms | |
3671 | CALL PHO_PHIST(1,HSWGHT(0)) | |
3672 | CALL PHO_LHIST(1,HSWGHT(0)) | |
3673 | 200 CONTINUE | |
3674 | ||
3675 | C final cross section calculation and event generation summary | |
3676 | ||
3677 | else if(NEVENT.eq.-2) then | |
3678 | ||
3679 | * EVWGHT(1) = 1.D0 | |
3680 | * IVWGHT(1) = 0 | |
3681 | DITRY = dble(ITRY_high)*1.D+6+dble(ITRY_low) | |
3682 | DITRW = dble(ITRW_high)*1.D+6+dble(ITRW_low) | |
3683 | WGY = WGMAX*DITRY/DITRW/(137.D0*2.D0*PI)**2 | |
3684 | WGY = WGY*LOG(YMAX1/YMIN1)*LOG(YMAX2/YMIN2) | |
3685 | AY1 = AY1/DBLE(NITER) | |
3686 | AYS1 = AYS1/DBLE(NITER) | |
3687 | DAY1 = SQRT((AYS1-AY1**2)/DBLE(NITER)) | |
3688 | AY2 = AY2/DBLE(NITER) | |
3689 | AYS2 = AYS2/DBLE(NITER) | |
3690 | DAY2 = SQRT((AYS2-AY2**2)/DBLE(NITER)) | |
3691 | Q21AVE = Q21AVE/DBLE(NITER) | |
3692 | Q21AV2 = Q21AV2/DBLE(NITER) | |
3693 | Q21AV2 = SQRT((Q21AV2-Q21AVE**2)/DBLE(NITER)) | |
3694 | Q22AVE = Q22AVE/DBLE(NITER) | |
3695 | Q22AV2 = Q22AV2/DBLE(NITER) | |
3696 | Q22AV2 = SQRT((Q22AV2-Q22AVE**2)/DBLE(NITER)) | |
3697 | WEIGHT = WGY*SIGMAX*DBLE(NITER)/DITRY | |
3698 | EE1 = WEIGHT | |
3699 | EE2 = SIGMAX*DBLE(NITER)/DITRY | |
3700 | ||
3701 | C output of statistics, histograms | |
3702 | WRITE(LO,'(//1X,A,/1X,A,1PE12.3,A,/1X,A)') | |
3703 | & '=========================================================', | |
3704 | & ' ***** simulated cross section: ',WEIGHT,' mb *****', | |
3705 | & '=========================================================' | |
3706 | WRITE(LO,'(//1X,A,I10,1p,2e14.6)') | |
3707 | & 'PHO_GGEPEM:summary: NITER,ITRY,ITRW',NITER,DITRY,DITRW | |
3708 | WRITE(LO,'(1X,A,1P2E12.4)') 'effective weight (FLUX,TOTAL)', | |
3709 | & WGY,WEIGHT | |
3710 | WRITE(LO,'(1X,A,1P2E12.4)') 'average Y1,DY1 ', | |
3711 | & AY1,DAY1 | |
3712 | WRITE(LO,'(1X,A,1P2E12.4)') 'average Y2,DY2 ', | |
3713 | & AY2,DAY2 | |
3714 | WRITE(LO,'(1X,A,1P2E12.4)') 'sampled Y range photon 1 ', | |
3715 | & YY1MIN,YY1MAX | |
3716 | WRITE(LO,'(1X,A,1P2E12.4)') 'sampled Y range photon 2 ', | |
3717 | & YY2MIN,YY2MAX | |
3718 | WRITE(LO,'(1X,A,1P2E12.4)') 'average Q2,DQ2 photon 1 ', | |
3719 | & Q21AVE,Q21AV2 | |
3720 | WRITE(LO,'(1X,A,1P2E12.4)') 'sampled Q2 range photon 1 ', | |
3721 | & Q21MIN,Q21MAX | |
3722 | WRITE(LO,'(1X,A,1P2E12.4)') 'average Q2,DQ2 photon 2 ', | |
3723 | & Q22AVE,Q22AV2 | |
3724 | WRITE(LO,'(1X,A,1P2E12.4)') 'sampled Q2 range photon 2 ', | |
3725 | & Q22MIN,Q22MAX | |
3726 | WRITE(LO,'(1X,A,1P2E12.4)') 'sampled THETA range electron1', | |
3727 | & AN1MIN,AN1MAX | |
3728 | WRITE(LO,'(1X,A,1P4E12.4)') 'sampled THETA range electron2', | |
3729 | & AN2MIN,AN2MAX,PI-AN2MAX,PI-AN2MIN | |
3730 | ||
3731 | IF(ISWMDL(10).GE.2) THEN | |
3732 | WRITE(LO,'(/1X,A,3(/1X,A,4I12))') | |
3733 | & 'Helicity decomposition: 0 0 0 1 1 0 1 1', | |
3734 | & 'tried: ',IHETRY, | |
3735 | & 'accepted (1): ',IHEAC1, | |
3736 | & 'accepted (2): ',IHEAC2 | |
3737 | ENDIF | |
3738 | ||
3739 | CALL PHO_EVENT(-2,P1,P2,WEIGHT,IREJ) | |
3740 | IF(NITER.GT.1) THEN | |
3741 | CALL PHO_PHIST(-2,WEIGHT) | |
3742 | CALL PHO_LHIST(-2,WEIGHT) | |
3743 | ELSE | |
3744 | WRITE(LO,'(1X,A,I4)') | |
3745 | & 'PHO_GGEPEM: no output of histograms',NITER | |
3746 | ENDIF | |
3747 | ||
3748 | endif | |
3749 | ||
3750 | END | |
3751 | ||
3752 | *$ CREATE PHO_WGEPEM.FOR | |
3753 | *COPY PHO_WGEPEM | |
3754 | CDECK ID>, PHO_WGEPEM | |
3755 | SUBROUTINE PHO_WGEPEM(WGHAPP,WGHQPM,IMODE) | |
3756 | C********************************************************************** | |
3757 | C | |
3758 | C calculate cross section weights for | |
3759 | C fully differential equivalent (improved) photon approximation | |
3760 | C and/or | |
3761 | C fully differential QPM model with exact one-photon exchange graphs | |
3762 | C | |
3763 | C (unpolarized lepton beams) | |
3764 | C | |
3765 | C input: IMODE 0 flux calculation only | |
3766 | C 1 flux folded with QPM cross section | |
3767 | C /POFSRC/ photon and electron momenta | |
3768 | C /POPRCS/ process type | |
3769 | C /POCKIN/ kinematics of hard scattering | |
3770 | C | |
3771 | C output: WGHAPP weight of event according to approximation | |
3772 | C WGHQPM weight of event according to one-photon exchange | |
3773 | C | |
3774 | C********************************************************************** | |
3775 | IMPLICIT NONE | |
3776 | SAVE | |
3777 | ||
3778 | DOUBLE PRECISION WGHAPP,WGHQPM | |
3779 | INTEGER IMODE | |
3780 | ||
3781 | C input/output channels | |
3782 | INTEGER LI,LO | |
3783 | COMMON /POINOU/ LI,LO | |
3784 | C event debugging information | |
3785 | INTEGER NMAXD | |
3786 | PARAMETER (NMAXD=100) | |
3787 | INTEGER IDEB,KSPOM,KHPOM,KSREG,KHDIR,KACCEP,KSTRG,KHTRG,KSLOO, | |
3788 | & KHLOO,KSDPO,KHDPO,KEVENT,KSOFT,KHARD | |
3789 | COMMON /PODEBG/ IDEB(NMAXD),KSPOM,KHPOM,KSREG,KHDIR,KACCEP,KSTRG, | |
3790 | & KHTRG,KSLOO,KHLOO,KSDPO,KHDPO,KEVENT,KSOFT,KHARD | |
3791 | C model switches and parameters | |
3792 | CHARACTER*8 MDLNA | |
3793 | INTEGER ISWMDL,IPAMDL | |
3794 | DOUBLE PRECISION PARMDL | |
3795 | COMMON /POMDLS/ MDLNA(50),ISWMDL(50),PARMDL(400),IPAMDL(400) | |
3796 | C some constants | |
3797 | DOUBLE PRECISION PI,PI2,PI4,GEV2MB,Q_ch,Q_ch2,Q_ch4 | |
3798 | COMMON /POCONS/ PI,PI2,PI4,GEV2MB, | |
3799 | & Q_ch(-6:6),Q_ch2(-6:6),Q_ch4(-6:6) | |
3800 | C gamma-lepton or gamma-hadron vertex information | |
3801 | INTEGER IGHEL,IDPSRC,IDBSRC | |
3802 | DOUBLE PRECISION PINI,PFIN,PGAM,GYY,GQ2,GGECM,GAIMP,PFTHE,PFPHI, | |
3803 | & RADSRC,AMSRC,GAMSRC | |
3804 | COMMON /POFSRC/ PINI(5,2),PFIN(5,2),PGAM(5,2),IGHEL(2), | |
3805 | & GYY(2),GQ2(2),GGECM,GAIMP(2),PFTHE(2),PFPHI(2), | |
3806 | & IDPSRC(2),IDBSRC(2),RADSRC(2),AMSRC(2),GAMSRC(2) | |
3807 | C general process information | |
3808 | INTEGER IPROCE,IDNODF,IDIFR1,IDIFR2,IDDPOM,IPRON | |
3809 | COMMON /POPRCS/ IPROCE,IDNODF,IDIFR1,IDIFR2,IDDPOM,IPRON(15,4) | |
3810 | C data on most recent hard scattering | |
3811 | INTEGER IA,IB,IC,ID,IV1,IV2,MSPR,IREJSC | |
3812 | DOUBLE PRECISION PTWANT,AS,AH,ALNS,ALNH,Z1MAX,Z1DIF,Z2MAX,Z2DIF, | |
3813 | & PT,PTfin,ETAC,ETAD,X1,X2,V,U,W,W1,AXX,QQPD,QQAL, | |
3814 | & PDF1,PDF2,WEIGHT,PHI1,PHI2,PHO1,PHO2 | |
3815 | COMMON /POCKIN/ PTWANT,AS,AH,ALNS,ALNH,Z1MAX,Z1DIF,Z2MAX,Z2DIF, | |
3816 | & PT,PTfin,ETAC,ETAD,X1,X2,V,U,W,W1,AXX, | |
3817 | & QQPD,QQAL,PDF1(-6:6),PDF2(-6:6),WEIGHT, | |
3818 | & PHI1(5),PHI2(5),PHO1(5),PHO2(5), | |
3819 | & IA,IB,IC,ID,IV1,IV2,MSPR,IREJSC | |
3820 | C hard scattering parameters used for most recent hard interaction | |
3821 | INTEGER NFbeta,NF | |
3822 | DOUBLE PRECISION ALQCD2,BQCD | |
3823 | COMMON /POHAPA/ ALQCD2(3,4),BQCD(4),NFbeta,NF | |
3824 | C currently activated parton density parametrizations | |
3825 | CHARACTER*8 PDFNAM | |
3826 | INTEGER IPARID,IPAVA,ITYPE,IGRP,ISET,IEXT,NPAOLD | |
3827 | DOUBLE PRECISION PDFLAM,PDFQ2M | |
3828 | COMMON /POPPDF/ PDFLAM(2),PDFQ2M(2),PDFNAM(2),IPARID(2), | |
3829 | & IPAVA(2),ITYPE(2),IGRP(2),ISET(2),IEXT(2),NPAOLD | |
3830 | C standard particle data interface | |
3831 | INTEGER NMXHEP | |
3832 | PARAMETER (NMXHEP=4000) | |
3833 | INTEGER NEVHEP,NHEP,ISTHEP,IDHEP,JMOHEP,JDAHEP | |
3834 | DOUBLE PRECISION PHEP,VHEP | |
3835 | COMMON /POEVT1/ NEVHEP,NHEP,ISTHEP(NMXHEP),IDHEP(NMXHEP), | |
3836 | & JMOHEP(2,NMXHEP),JDAHEP(2,NMXHEP),PHEP(5,NMXHEP), | |
3837 | & VHEP(4,NMXHEP) | |
3838 | C extension to standard particle data interface (PHOJET specific) | |
3839 | INTEGER IMPART,IPHIST,ICOLOR | |
3840 | COMMON /POEVT2/ IMPART(NMXHEP),IPHIST(2,NMXHEP),ICOLOR(2,NMXHEP) | |
3841 | ||
3842 | DOUBLE PRECISION AA,ALPHA1,ALPHA2,BB,CC,CCAP,DD,FAC,HELFLX, | |
3843 | & P1,P1P2,P1Q2,P2,P2Q1,Q1KK,Q1Q2,Q2,Q2KK,QC2,RHO100,RHO1PP, | |
3844 | & RHO200,RHO2PP,RHOP08,RHOPM2,RR,SH,SIGQPM,SP,SS,SW0000,SW0P0M, | |
3845 | & SW0P0P,SW0PM0,SWP00P,SWP0M0,SWP0P0,SWPMPM,SWPP00,SWPPMM,SWPPPP, | |
3846 | & TH,TP,UH,W2,WGHEQ,WGHQQ,XCAP,XK1,XK2,XKAM,XKAP, | |
3847 | & XM2,XQ2,XTM1,XTM2,XTM3,YCAP | |
3848 | DOUBLE PRECISION PHO_ALPHAS,pho_alphae | |
3849 | ||
3850 | INTEGER I,I1,I2,IDIR,IPFL1,IPFL2,IPOS,K | |
3851 | ||
3852 | DIMENSION WGHEQ(2),XM2(2),P1(4),P2(4),XK1(4),XK2(4) | |
3853 | DIMENSION HELFLX(6),SIGQPM(6) | |
3854 | ||
3855 | WGHAPP = 1.D0 | |
3856 | WGHQPM = 0.D0 | |
3857 | ||
3858 | C strict pt cutoff after putting partons on mass shell, | |
3859 | C calculated in gamma-gamma CMS | |
3860 | if((Imode.eq.1).and.(ipamdl(121).gt.0)) then | |
3861 | if(PTfin.lt.PTwant) then | |
3862 | if(ipamdl(121).gt.1) return | |
3863 | if((ipamdl(121).eq.1).and.(MSPR.eq.14)) return | |
3864 | endif | |
3865 | endif | |
3866 | ||
3867 | C cross section of sampled event (approximate treatment) | |
3868 | ||
3869 | C photon flux | |
3870 | DO 50 K=1,2 | |
3871 | XM2(K) = AMSRC(K)**2 | |
3872 | IF(abs(IGHEL(K)).EQ.1) THEN | |
3873 | WGHEQ(K) = ((1.D0+(1.D0-GYY(K))**2)/GYY(K) | |
3874 | & -2.D0*XM2(K)*GYY(K)/GQ2(K))/(137.D0*2.D0*PI*GQ2(K)) | |
3875 | ELSE | |
3876 | WGHEQ(K) = (1.D0-GYY(K))/GYY(K)/(137.D0*PI*GQ2(K)) | |
3877 | ENDIF | |
3878 | 50 CONTINUE | |
3879 | ||
3880 | W2 = GGECM*GGECM | |
3881 | IDIR = 0 | |
3882 | WGHQQ = 1.D0 | |
3883 | ||
3884 | C direct or single-resolved gam-gam interaction | |
3885 | IF((IMODE.GE.1).AND. | |
3886 | & (IPROCE.EQ.8).AND.(MSPR.GE.10)) THEN | |
3887 | IDIR = 1 | |
3888 | WGHQQ = 0.D0 | |
3889 | C determine final state partons | |
3890 | DO 100 I=3,NHEP | |
3891 | IF(ISTHEP(I).EQ.25) GOTO 110 | |
3892 | 100 CONTINUE | |
3893 | WRITE(LO,'(/1X,2A,I5)') 'PHO_WGEPEM:ERROR: ', | |
3894 | & 'inconsistent process information (MSPR)',MSPR | |
3895 | CALL PHO_ABORT | |
3896 | 110 CONTINUE | |
3897 | IPOS = I | |
3898 | C final state flavors | |
3899 | IPFL1 = ABS(IDHEP(IPOS+3)) | |
3900 | IPFL2 = ABS(IDHEP(IPOS+4)) | |
3901 | SH = X1*X2*W2 | |
3902 | C calculate alpha-em | |
3903 | ALPHA1 = pho_alphae(QQAL) | |
3904 | C calculate alpha-s | |
3905 | IF(MSPR.LT.14) THEN | |
3906 | ALPHA2 = PHO_ALPHAS(QQAL,3) | |
3907 | ENDIF | |
3908 | C LO matrix element (8 pi s dsig/dt) | |
3909 | * QC2 = 4.D0/9.D0 - DBLE(MOD(IPFL2,2))*3.D0/9.D0 | |
3910 | QC2 = Q_ch2(IPFL2) | |
3911 | IF(IPFL2.EQ.0) THEN | |
3912 | WRITE(LO,'(1X,2A,/,5X,A,I12,I3,4I4)') 'PHO_WGEPEM:ERROR: ', | |
3913 | & 'invalid hard process - flavor combination', | |
3914 | & 'EVENT,MSPR,IA,IB,IC,ID:',KEVENT,MSPR,IA,IB,IC,ID | |
3915 | ENDIF | |
3916 | IF(MSPR.EQ.10) THEN | |
3917 | WGHQQ = -8.D0*PI/(3.D0*SH**2)*ALPHA1*QC2*ALPHA2*(U**2+1.D0)/U | |
3918 | & *8.D0*PI*SH | |
3919 | ELSE IF(MSPR.EQ.11) THEN | |
3920 | WGHQQ = PI/SH**2*ALPHA1*QC2*ALPHA2*(V**2+U**2)/(U*V) | |
3921 | & *8.D0*PI*SH | |
3922 | ELSE IF(MSPR.EQ.12) THEN | |
3923 | WGHQQ = -8.D0*PI/(3.D0*SH**2)*ALPHA1*QC2*ALPHA2*(V**2+1.D0)/V | |
3924 | & *8.D0*PI*SH | |
3925 | ELSE IF(MSPR.EQ.13) THEN | |
3926 | WGHQQ = PI/SH**2*ALPHA1*QC2*ALPHA2*(V**2+U**2)/(U*V) | |
3927 | & *8.D0*PI*SH | |
3928 | ELSE IF(MSPR.EQ.14) THEN | |
3929 | WGHQQ = 6.D0*PI/SH**2*(ALPHA1*QC2)**2*(V**2+U**2)/(U*V) | |
3930 | & *8.D0*PI*SH | |
3931 | ENDIF | |
3932 | ENDIF | |
3933 | ||
3934 | C fully differential cross section dsig/(dQ_^2 dQ_2^2 dy_1 dy_2 dphi) | |
3935 | WGHAPP = WGHEQ(1)*WGHEQ(2)*WGHQQ/(2.D0*PI) | |
3936 | ||
3937 | C full leading-order QPM prediction (Budnev et al.) | |
3938 | ||
3939 | C full two-gamma flux | |
3940 | ||
3941 | P1Q2 = PINI(4,1)*PGAM(4,2)-PINI(1,1)*PGAM(1,2) | |
3942 | & -PINI(2,1)*PGAM(2,2)-PINI(3,1)*PGAM(3,2) | |
3943 | P2Q1 = PINI(4,2)*PGAM(4,1)-PINI(1,2)*PGAM(1,1) | |
3944 | & -PINI(2,2)*PGAM(2,1)-PINI(3,2)*PGAM(3,1) | |
3945 | Q1Q2 = PGAM(4,1)*PGAM(4,2)-PGAM(1,1)*PGAM(1,2) | |
3946 | & -PGAM(2,1)*PGAM(2,2)-PGAM(3,1)*PGAM(3,2) | |
3947 | P1P2 = PINI(4,1)*PINI(4,2)-PINI(1,1)*PINI(1,2) | |
3948 | & -PINI(2,1)*PINI(2,2)-PINI(3,1)*PINI(3,2) | |
3949 | DO 120 I=1,4 | |
3950 | P1(I) = 2.D0*PINI(I,1)-PGAM(I,1) | |
3951 | P2(I) = 2.D0*PINI(I,2)-PGAM(I,2) | |
3952 | 120 CONTINUE | |
3953 | XTM1 = 2.D0*P1Q2-Q1Q2 | |
3954 | XTM2 = 2.D0*P2Q1-Q1Q2 | |
3955 | XTM3 = P1(4)*P2(4)-P1(1)*P2(1)-P1(2)*P2(2)-P1(3)*P2(3) | |
3956 | XCAP = Q1Q2**2-GQ2(1)*GQ2(2) | |
3957 | YCAP = P1P2**2-XM2(1)*XM2(2) | |
3958 | CCAP = -XTM3 + Q1Q2*XTM1*XTM2/XCAP | |
3959 | ||
3960 | RHO1PP = (XTM1**2/XCAP+1.D0-4.D0*XM2(1)/GQ2(1))/2.D0 | |
3961 | RHO2PP = (XTM2**2/XCAP+1.D0-4.D0*XM2(2)/GQ2(2))/2.D0 | |
3962 | RHO100 = XTM1**2/XCAP-1.D0 | |
3963 | RHO200 = XTM2**2/XCAP-1.D0 | |
3964 | RHOPM2 = CCAP**2/(GQ2(1)*GQ2(2))-2.D0*(RHO1PP-1.D0)*(RHO2PP-1.D0) | |
3965 | RHOP08 = 4.D0*XTM1*XTM2*CCAP/XCAP/SQRT(GQ2(1)*GQ2(2)) | |
3966 | SS = 2.D0*P1P2+XM2(1)+XM2(2) | |
3967 | ||
3968 | HELFLX(1) = 4.D0*RHO1PP*RHO2PP | |
3969 | HELFLX(2) = RHOPM2 | |
3970 | HELFLX(3) = 2.D0*RHO1PP*RHO200 | |
3971 | HELFLX(4) = 2.D0*RHO100*RHO2PP | |
3972 | HELFLX(5) = RHO100*RHO200 | |
3973 | HELFLX(6) = -RHOP08 | |
3974 | ||
3975 | C only flux calculation | |
3976 | ||
3977 | IF(IDIR.EQ.0) THEN | |
3978 | IF((IGHEL(1).EQ.1).AND.(IGHEL(2).EQ.1)) THEN | |
3979 | WEIGHT = HELFLX(1) | |
3980 | ELSE IF((IGHEL(1).EQ.1).AND.(IGHEL(2).EQ.0)) THEN | |
3981 | WEIGHT = HELFLX(3) | |
3982 | ELSE IF((IGHEL(1).EQ.0).AND.(IGHEL(2).EQ.1)) THEN | |
3983 | WEIGHT = HELFLX(4) | |
3984 | ELSE IF((IGHEL(1).EQ.0).AND.(IGHEL(2).EQ.0)) THEN | |
3985 | WEIGHT = HELFLX(5) | |
3986 | ELSE IF((IGHEL(1).EQ.-1).AND.(IGHEL(2).EQ.-1)) THEN | |
3987 | WEIGHT = HELFLX(1) | |
3988 | ELSE | |
3989 | WRITE(LO,'(/1X,A,2I3)') | |
3990 | & 'PHO_GGEPEM:ERROR: invalid photon helicities: ',IGHEL | |
3991 | WRITE(LO,'(1X,A,I12)') | |
3992 | & 'PHO_GGEPEM: event rejected (KEVENT)',KEVENT | |
3993 | WEIGHT = 0.D0 | |
3994 | ENDIF | |
3995 | ||
3996 | C fully differential cross section dsig/(dQ_^2 dQ_2^2 dy_1 dy_2 dphi) | |
3997 | WGHQPM = WEIGHT/(137.D0**2*16.D0*PI**4*GQ2(1)*GQ2(2)) | |
3998 | & *SQRT(XCAP/YCAP)*PI*SS/(2.D0*YCAP)*PINI(4,1)*PINI(4,2) | |
3999 | ||
4000 | ELSE | |
4001 | ||
4002 | C flux folded with cross section | |
4003 | C polarized, leading order gam gam --> q qbar cross sections | |
4004 | ||
4005 | DO 125 I=1,6 | |
4006 | SIGQPM(I) = 0.D0 | |
4007 | 125 CONTINUE | |
4008 | C momenta of produced parton pair | |
4009 | I1 = IPOS+3 | |
4010 | I2 = IPOS+4 | |
4011 | DO 150 K=1,4 | |
4012 | XK1(K) = PHEP(K,I1) | |
4013 | XK2(K) = PHEP(K,I2) | |
4014 | 150 CONTINUE | |
4015 | XQ2 = PHEP(5,I2)**2 | |
4016 | ||
4017 | IF(MSPR.EQ.14) THEN | |
4018 | C direct photon-photon interaction | |
4019 | XKAP = XQ2-(PGAM(4,1)-XK1(4))**2 | |
4020 | & +(PGAM(1,1)-XK1(1))**2+(PGAM(2,1)-XK1(2))**2 | |
4021 | & +(PGAM(3,1)-XK1(3))**2 | |
4022 | XKAM = XQ2-(PGAM(4,1)-XK2(4))**2 | |
4023 | & +(PGAM(1,1)-XK2(1))**2+(PGAM(2,1)-XK2(2))**2 | |
4024 | & +(PGAM(3,1)-XK2(3))**2 | |
4025 | CC = Q1Q2 | |
4026 | AA = XKAP*XKAM-GQ2(1)*GQ2(2) | |
4027 | BB = CC**2-XKAP*XKAM | |
4028 | DD = CC**2-GQ2(1)*GQ2(2) | |
4029 | RR = -XQ2+W2*AA/(4.D0*DD) | |
4030 | Q1KK = Q1Q2-GQ2(1) | |
4031 | Q2KK = Q1Q2-GQ2(2) | |
4032 | FAC = 192.D0*(PI*ALPHA1*QC2/(XKAP*XKAM))**2/(4.D0*SQRT(XCAP)) | |
4033 | ||
4034 | ELSE | |
4035 | C single-resolved photon-hadron interactions | |
4036 | C Mandelstam variables | |
4037 | IF(MSPR.LE.11) THEN | |
4038 | TH = (PGAM(4,1)-XK1(4))**2-(PGAM(1,1)-XK1(1))**2 | |
4039 | & -(PGAM(2,1)-XK1(2))**2-(PGAM(3,1)-XK1(3))**2 | |
4040 | UH = (PGAM(4,1)-XK2(4))**2-(PGAM(1,1)-XK2(1))**2 | |
4041 | & -(PGAM(2,1)-XK2(2))**2-(PGAM(3,1)-XK2(3))**2 | |
4042 | ELSE | |
4043 | TH = (PGAM(4,2)-XK2(4))**2-(PGAM(1,2)-XK2(1))**2 | |
4044 | & -(PGAM(2,2)-XK2(2))**2-(PGAM(3,2)-XK2(3))**2 | |
4045 | UH = (PGAM(4,2)-XK1(4))**2-(PGAM(1,2)-XK1(1))**2 | |
4046 | & -(PGAM(2,2)-XK1(2))**2-(PGAM(3,2)-XK1(3))**2 | |
4047 | ENDIF | |
4048 | V = TH/SH | |
4049 | U = UH/SH | |
4050 | ENDIF | |
4051 | ||
4052 | WEIGHT = 0.D0 | |
4053 | IF((IGHEL(1).EQ.1).AND.(IGHEL(2).EQ.1)) THEN | |
4054 | IF((MSPR.EQ.10).OR.(MSPR.EQ.12)) THEN | |
4055 | IF(MSPR.EQ.10) THEN | |
4056 | Q2 = -GQ2(1) | |
4057 | SP = SH-XQ2 | |
4058 | TP = UH-XQ2 | |
4059 | ELSE | |
4060 | Q2 = -GQ2(2) | |
4061 | SP = SH-XQ2 | |
4062 | TP = TH-XQ2 | |
4063 | ENDIF | |
4064 | SIGQPM(1)= -32.D0*PI**2*4.D0/3.D0*ALPHA1*QC2*ALPHA2 | |
4065 | & *(SP*TP*(2.D0*Q2**4-4.D0*Q2*SP**3-2.D0*Q2**3*(3*SP+TP) | |
4066 | & +SP**2*(SP**2+TP**2)+Q2**2*(7.D0*SP**2+2.D0*SP*TP+TP**2)) | |
4067 | & -2.D0*(2.D0*SP**3*TP*(SP+TP)+Q2**3*(SP**2+6.D0*SP*TP+TP**2) | |
4068 | & -2.D0*Q2**2*SP*(SP**2+4.D0*SP*TP+3.D0*TP**2)+Q2*SP* | |
4069 | & (SP**3+SP**2*TP-SP*TP**2+TP**3))*XQ2 + | |
4070 | & 4.D0*(2.D0*Q2**2-SP**2)*(SP+TP)**2*XQ2**2)/ | |
4071 | & (SP**2*TP**2*((Q2-SP)**2-4.D0*Q2*XQ2)) | |
4072 | WEIGHT = HELFLX(1)*SIGQPM(1)/(2.D0*(SH+GQ2(1)+GQ2(2))) | |
4073 | ELSE IF((MSPR.EQ.11).OR.(MSPR.EQ.13)) THEN | |
4074 | IF(MSPR.EQ.11) THEN | |
4075 | Q2 = -GQ2(1) | |
4076 | ELSE | |
4077 | Q2 = -GQ2(2) | |
4078 | ENDIF | |
4079 | SP = SH | |
4080 | TP = UH | |
4081 | SIGQPM(1) = -32.D0*PI**2/2.D0*ALPHA1*QC2*ALPHA2 | |
4082 | & *(-((Q2**2+SP**2)*TP*(Q2**3-SP**3-3.D0*SP**2*TP | |
4083 | & - 4.D0*SP*TP**2 - 2.D0*TP**3 - 3.D0*Q2**2*(SP + TP) + Q2* | |
4084 | & (3.D0*SP**2 + 6.D0*SP*TP + 4.D0*TP**2))) + | |
4085 | & (3.D0*Q2**5 - Q2**4*(11.D0*SP + 10.D0*TP) + | |
4086 | & 4.D0*Q2**3*(4.D0*SP**2 + 5.D0*SP*TP + 4.D0*TP**2) | |
4087 | & +Q2*SP**2*(5.D0*SP**2+4.D0*SP*TP+8.D0*TP**2)-4.D0*Q2**2 | |
4088 | & *(3.D0*SP**3+3.D0*SP**2*TP+4.D0*SP*TP**2+2.D0*TP**3)- | |
4089 | & SP**2*(SP**3+2.D0*SP**2*TP+8.D0*SP*TP**2+8.D0*TP**3))*XQ2+ | |
4090 | & (11.D0*Q2**4-10.D0*Q2**3*(3.D0*SP+2.D0*TP)-2.D0*Q2*SP**2 | |
4091 | & *(7.D0*SP+2.D0*TP)+2.D0*Q2**2*(15.D0*SP**2+10.D0*SP*TP | |
4092 | & +6.D0*TP**2)+SP**2*(3.D0*SP**2+4.D0*SP*TP+12.D0*TP**2)) | |
4093 | & *XQ2**2+8.D0*(Q2**3-SP**2*TP-Q2**2*(SP+TP))*XQ2**3+ | |
4094 | & 2.D0*(Q2**2+SP**2)*XQ2**4)/((Q2-SP)**2*(-TP+XQ2)**2* | |
4095 | & (Q2-SP-TP+XQ2)**2) | |
4096 | WEIGHT = HELFLX(1)*SIGQPM(1)/(2.D0*(SH+GQ2(1)+GQ2(2))) | |
4097 | ELSE IF(MSPR.EQ.14) THEN | |
4098 | SWPMPM = 4.D0*CC**2*RR*(W2-2.D0*RR) | |
4099 | SWPPPP = SWPMPM +2.D0*(CC**2+BB)*(AA-4.D0*RR*CC) | |
4100 | SWPPMM = 8.D0*RR*CC*(XKAP*XKAM-RR*CC) | |
4101 | & -2.D0*XKAP*XKAM*AA | |
4102 | SIGQPM(1) = (SWPPPP+SWPMPM)/2.D0*FAC | |
4103 | SIGQPM(2) = SWPPMM*FAC | |
4104 | WEIGHT = HELFLX(1)*SIGQPM(1) | |
4105 | & +HELFLX(2)*SIGQPM(2) | |
4106 | ENDIF | |
4107 | ELSE IF((IGHEL(1).EQ.1).AND.(IGHEL(2).EQ.0)) THEN | |
4108 | IF(MSPR.EQ.12) THEN | |
4109 | Q2 = -GQ2(2) | |
4110 | SP = SH-XQ2 | |
4111 | TP = TH-XQ2 | |
4112 | SIGQPM(3) = 32.D0*PI**2*8.D0/3.D0*ALPHA1*QC2*ALPHA2 | |
4113 | & *Q2*(-(SP**2*TP**2*(-Q2 + SP + TP)) + | |
4114 | & SP*TP*(2.D0*Q2**2 + 3.D0*SP**2 + 2.D0*SP*TP - | |
4115 | & TP**2 - 2.D0*Q2*(3*SP + TP))*XQ2 - | |
4116 | & 2.D0*(Q2*(SP**2 + 6.D0*SP*TP + TP**2) - | |
4117 | & 2.D0*SP*(SP**2 + 4.D0*SP*TP + 3.D0*TP**2))* | |
4118 | & XQ2**2 + 8.D0*(SP + TP)**2*XQ2**3)/ | |
4119 | & (SP**2*TP**2*((Q2 - SP)**2 - 4.D0*Q2*XQ2)) | |
4120 | WEIGHT = HELFLX(3)*SIGQPM(3)/(2.D0*(SH+GQ2(2))) | |
4121 | ELSE IF(MSPR.EQ.13) THEN | |
4122 | Q2 = -GQ2(2) | |
4123 | SP = SH | |
4124 | TP = TH | |
4125 | SIGQPM(3) = 32.D0*PI**2*2.D0*ALPHA1*QC2*ALPHA2 | |
4126 | & *(-Q2*(SP*TP*(-Q2+SP+TP)+(Q2**2-Q2*SP-2*SP*TP)*XQ2 + | |
4127 | & SP*XQ2**2))/((Q2-SP)**2*(-TP+XQ2)*(Q2-SP-TP+XQ2)) | |
4128 | WEIGHT = HELFLX(3)*SIGQPM(3)/(2.D0*(SH+GQ2(2))) | |
4129 | ELSE IF(MSPR.EQ.14) THEN | |
4130 | SWP0M0 = 4.D0*RR*GQ2(2)*(-CC**2*GQ2(1)*W2 | |
4131 | & -XKAP*XKAM*Q1KK**2)/DD | |
4132 | SWP0P0 = - SWP0M0+2.D0*GQ2(2)*GQ2(1)**2*W2*BB/DD | |
4133 | SWPP00 = 2.D0*W2*BB*(AA-2.D0*CC*RR) | |
4134 | & *SQRT(GQ2(1)*GQ2(2))/DD | |
4135 | SWP00P = 4.D0*RR*(CC**2*(GQ2(1)*Q2KK+GQ2(2)*Q1KK) | |
4136 | & +XKAP*XKAM*Q1KK*Q2KK)*SQRT(GQ2(1)*GQ2(2))/DD | |
4137 | SW0PM0 = -SWP00P-2.D0*GQ2(1)*GQ2(2)*W2*BB | |
4138 | & *SQRT(GQ2(1)*GQ2(2))/DD | |
4139 | SIGQPM(3) = SWP0P0*FAC | |
4140 | SIGQPM(6) = (SWPP00+SW0PM0)/2.D0*FAC | |
4141 | WEIGHT = HELFLX(3)*SIGQPM(3) | |
4142 | & +HELFLX(6)*SIGQPM(6)/2.D0 | |
4143 | ENDIF | |
4144 | ELSE IF((IGHEL(1).EQ.0).AND.(IGHEL(2).EQ.1)) THEN | |
4145 | IF(MSPR.EQ.10) THEN | |
4146 | Q2 = -GQ2(1) | |
4147 | SP = SH-XQ2 | |
4148 | TP = UH-XQ2 | |
4149 | SIGQPM(4) = 32.D0*PI**2*8.D0/3.D0*ALPHA1*QC2*ALPHA2 | |
4150 | & *Q2*(-(SP**2*TP**2*(-Q2 + SP + TP)) + | |
4151 | & SP*TP*(2.D0*Q2**2 + 3.D0*SP**2 + 2.D0*SP*TP - | |
4152 | & TP**2 - 2.D0*Q2*(3*SP + TP))*XQ2 - | |
4153 | & 2.D0*(Q2*(SP**2 + 6.D0*SP*TP + TP**2) - | |
4154 | & 2.D0*SP*(SP**2 + 4.D0*SP*TP + 3.D0*TP**2))* | |
4155 | & XQ2**2 + 8.D0*(SP + TP)**2*XQ2**3)/ | |
4156 | & (SP**2*TP**2*((Q2 - SP)**2 - 4.D0*Q2*XQ2)) | |
4157 | WEIGHT = HELFLX(4)*SIGQPM(4)/(2.D0*(SH+GQ2(1))) | |
4158 | ELSE IF(MSPR.EQ.11) THEN | |
4159 | Q2 = -GQ2(1) | |
4160 | SP = SH | |
4161 | TP = TH | |
4162 | SIGQPM(4) = 32.D0*PI**2*2.D0*ALPHA1*QC2*ALPHA2 | |
4163 | & *(-Q2*(SP*TP*(-Q2+SP+TP)+(Q2**2-Q2*SP-2*SP*TP)*XQ2 + | |
4164 | & SP*XQ2**2))/((Q2-SP)**2*(-TP+XQ2)*(Q2-SP-TP+XQ2)) | |
4165 | WEIGHT = HELFLX(4)*SIGQPM(4)/(2.D0*(SH+GQ2(2))) | |
4166 | ELSE IF(MSPR.EQ.14) THEN | |
4167 | SW0P0M = 4.D0*RR*GQ2(1)*(-CC**2*GQ2(2)*W2 | |
4168 | & -XKAP*XKAM*Q2KK**2)/DD | |
4169 | SW0P0P = - SW0P0M+2.D0*GQ2(1)*GQ2(2)**2*W2*BB/DD | |
4170 | SWPP00 = 2.D0*W2*BB*(AA-2.D0*CC*RR) | |
4171 | & *SQRT(GQ2(1)*GQ2(2))/DD | |
4172 | SWP00P = 4.D0*RR*(CC**2*(GQ2(1)*Q2KK+GQ2(2)*Q1KK) | |
4173 | & +XKAP*XKAM*Q1KK*Q2KK)*SQRT(GQ2(1)*GQ2(2))/DD | |
4174 | SW0PM0 = -SWP00P-2.D0*GQ2(1)*GQ2(2)*W2*BB | |
4175 | & *SQRT(GQ2(1)*GQ2(2))/DD | |
4176 | SIGQPM(4) = SW0P0P*FAC | |
4177 | SIGQPM(6) = (SWPP00+SW0PM0)/2.D0*FAC | |
4178 | WEIGHT = HELFLX(4)*SIGQPM(4) | |
4179 | & +HELFLX(6)*SIGQPM(6)/2.D0 | |
4180 | ENDIF | |
4181 | ELSE IF((IGHEL(1).EQ.0).AND.(IGHEL(2).EQ.0)) THEN | |
4182 | IF(MSPR.EQ.14) THEN | |
4183 | SW0000 = 2.D0*GQ2(1)*GQ2(2)*W2*W2*AA*BB/DD**2 | |
4184 | SIGQPM(5) = SW0000*FAC | |
4185 | WEIGHT = HELFLX(5)*SIGQPM(5) | |
4186 | ENDIF | |
4187 | ELSE | |
4188 | WRITE(LO,'(/1X,A,2I3)') | |
4189 | & 'PHO_GGEPEM:ERROR: invalid photon helicities: ',IGHEL | |
4190 | WRITE(LO,'(1X,A,I12)') | |
4191 | & 'PHO_GGEPEM: event rejected (KEVENT)',KEVENT | |
4192 | WEIGHT = 0.D0 | |
4193 | ENDIF | |
4194 | ||
4195 | C fully differential cross section dsig/(dQ_^2 dQ_2^2 dy_1 dy_2 dphi) | |
4196 | ||
4197 | WGHQPM = WEIGHT/(137.D0**2*16.D0*PI**4*GQ2(1)*GQ2(2)) | |
4198 | & *SQRT(XCAP/YCAP)*PI*SS/(2.D0*YCAP)*PINI(4,1)*PINI(4,2) | |
4199 | ||
4200 | ENDIF | |
4201 | ||
4202 | END | |
4203 | ||
4204 | *$ CREATE PHO_GGBLSR.FOR | |
4205 | *COPY PHO_GGBLSR | |
4206 | CDECK ID>, PHO_GGBLSR | |
4207 | SUBROUTINE PHO_GGBLSR(NEVENT,EE1,EE2, | |
4208 | & Pl_lam_1,Pl_lam_2,X_1,X_2,rho,A) | |
4209 | C*********************************************************************** | |
4210 | C | |
4211 | C interface to call PHOJET (variable energy run) for | |
4212 | C gamma-gamma collisions via laser backscattering | |
4213 | C | |
4214 | C input: EE1 lab. system energy of electron/positron 1 | |
4215 | C EE2 lab. system energy of electron/positron 2 | |
4216 | C NEVENT number of events to generate | |
4217 | C Pl_lam_1/2 product of electron and photon pol. | |
4218 | C X_1/2 standard X parameter | |
4219 | C rho ratio of distance to conversion point and | |
4220 | C transverse beam size | |
4221 | C A ellipticity of electon beam | |
4222 | C | |
4223 | C (see Ginzburg & Kotkin hep-ph/9905462) | |
4224 | C | |
4225 | C from /LEPCUT/: | |
4226 | C YMIN1 lower limit of Y1 | |
4227 | C (energy fraction taken by photon from electron) | |
4228 | C YMAX1 upper limit of Y1 | |
4229 | C YMIN2 lower limit of Y2 | |
4230 | C (energy fraction taken by photon from electron) | |
4231 | C YMAX2 upper limit of Y2 | |
4232 | C | |
4233 | C*********************************************************************** | |
4234 | IMPLICIT DOUBLE PRECISION (A-H,O-Z) | |
4235 | SAVE | |
4236 | ||
4237 | PARAMETER ( PI = 3.14159265359D0 ) | |
4238 | ||
4239 | C input/output channels | |
4240 | INTEGER LI,LO | |
4241 | COMMON /POINOU/ LI,LO | |
4242 | C event debugging information | |
4243 | INTEGER NMAXD | |
4244 | PARAMETER (NMAXD=100) | |
4245 | INTEGER IDEB,KSPOM,KHPOM,KSREG,KHDIR,KACCEP,KSTRG,KHTRG,KSLOO, | |
4246 | & KHLOO,KSDPO,KHDPO,KEVENT,KSOFT,KHARD | |
4247 | COMMON /PODEBG/ IDEB(NMAXD),KSPOM,KHPOM,KSREG,KHDIR,KACCEP,KSTRG, | |
4248 | & KHTRG,KSLOO,KHLOO,KSDPO,KHDPO,KEVENT,KSOFT,KHARD | |
4249 | C photon flux kinematics and cuts | |
4250 | DOUBLE PRECISION ECMIN,ECMAX,EEMIN1,EEMIN2, | |
4251 | & YMIN1,YMAX1,YMIN2,YMAX2, | |
4252 | & Q2MIN1,Q2MAX1,Q2MIN2,Q2MAX2, | |
4253 | & THMIN1,THMAX1,THMIN2,THMAX2 | |
4254 | INTEGER ITAG1,ITAG2 | |
4255 | COMMON /POFCUT/ ECMIN,ECMAX,EEMIN1,EEMIN2, | |
4256 | & YMIN1,YMAX1,YMIN2,YMAX2, | |
4257 | & Q2MIN1,Q2MAX1,Q2MIN2,Q2MAX2, | |
4258 | & THMIN1,THMAX1,THMIN2,THMAX2, | |
4259 | & ITAG1,ITAG2 | |
4260 | C gamma-lepton or gamma-hadron vertex information | |
4261 | INTEGER IGHEL,IDPSRC,IDBSRC | |
4262 | DOUBLE PRECISION PINI,PFIN,PGAM,GYY,GQ2,GGECM,GAIMP,PFTHE,PFPHI, | |
4263 | & RADSRC,AMSRC,GAMSRC | |
4264 | COMMON /POFSRC/ PINI(5,2),PFIN(5,2),PGAM(5,2),IGHEL(2), | |
4265 | & GYY(2),GQ2(2),GGECM,GAIMP(2),PFTHE(2),PFPHI(2), | |
4266 | & IDPSRC(2),IDBSRC(2),RADSRC(2),AMSRC(2),GAMSRC(2) | |
4267 | C nucleon-nucleus / nucleus-nucleus interface to DPMJET | |
4268 | INTEGER IDEQP,IDEQB,IHFLD,IHFLS | |
4269 | DOUBLE PRECISION ECMN,PCMN,SECM,SPCM,XPSUB,XTSUB | |
4270 | COMMON /POHDFL/ ECMN,PCMN,SECM,SPCM,XPSUB,XTSUB, | |
4271 | & IDEQP(2),IDEQB(2),IHFLD(2,2),IHFLS(2) | |
4272 | C event weights and generated cross section | |
4273 | INTEGER IPOWGC,ISWCUT,IVWGHT | |
4274 | DOUBLE PRECISION SIGGEN,HSWGHT,HSWCUT,EVWGHT | |
4275 | COMMON /POWGHT/ SIGGEN(4),HSWGHT(0:10),HSWCUT(20),EVWGHT(0:10), | |
4276 | & IPOWGC(0:10),ISWCUT(20),IVWGHT(0:10) | |
4277 | ||
4278 | parameter (N_dim=100) | |
4279 | dimension X_inp_1(N_dim),F_inp_1(N_dim),F_int_1(N_dim), | |
4280 | & X_inp_2(N_dim),F_inp_2(N_dim),F_int_2(N_dim), | |
4281 | & Xgrid(96),Wgrid(96) | |
4282 | ||
4283 | DIMENSION P1(4),P2(4) | |
4284 | ||
4285 | Pi2 = 2.D0*Pi | |
4286 | ||
4287 | WRITE(LO,'(//1X,A,I10)') 'PHO_GGBLSR: events to process',NEVENT | |
4288 | ||
4289 | YMAX1 = MIN(X_1/(1.D0+X_1),YMAX1) | |
4290 | YMAX2 = MIN(X_2/(1.D0+X_2),YMAX2) | |
4291 | IF((YMIN1.GT.YMAX1).OR.(YMIN2.GT.YMAX2)) THEN | |
4292 | WRITE(LO,'(/1X,2A,2E12.4)') 'PHO_GGBLSR:ERROR: ', | |
4293 | & 'invalid Ymin1,Ymin2',YMIN1,YMIN2 | |
4294 | RETURN | |
4295 | ENDIF | |
4296 | IDPSRC(1) = 0 | |
4297 | IDBSRC(1) = 0 | |
4298 | IDPSRC(2) = 0 | |
4299 | IDBSRC(2) = 0 | |
4300 | ||
4301 | C initialize sampling | |
4302 | ||
4303 | Max_tab = 50 | |
4304 | DELY1 = (YMAX1-YMIN1)/DBLE(Max_tab-1) | |
4305 | DELY2 = (YMAX2-YMIN2)/DBLE(Max_tab-1) | |
4306 | ||
4307 | IF(IDEB(30).GE.1) WRITE(LO,'(1X,A,I5)') | |
4308 | & 'PHO_GGBLSR: table of photon flux ',Max_tab | |
4309 | ||
4310 | DO 100 I=1,Max_tab | |
4311 | ||
4312 | y1 = YMIN1+DELY1*DBLE(I-1) | |
4313 | r1 = y1/(X_1*(1.D0-y1)) | |
4314 | X_inp_1(i) = y1 | |
4315 | F_inp_1(i) = 1.D0/(1.D0-y1)-y1+(2.D0*r1-1.D0)**2 | |
4316 | & -Pl_lam_1*X_1*r1*(2.D0*r1-1.D0)*(2.D0-y1) | |
4317 | ||
4318 | y2 = YMIN2+DELY2*DBLE(I-1) | |
4319 | r2 = y2/(X_2*(1.D0-y2)) | |
4320 | X_inp_2(i) = y2 | |
4321 | F_inp_2(i) = 1.D0/(1.D0-y2)-y2+(2.D0*r2-1.D0)**2 | |
4322 | & -Pl_lam_2*X_2*r2*(2.D0*r2-1.D0)*(2.D0-y2) | |
4323 | ||
4324 | IF(IDEB(30).GE.1) WRITE(LO,'(5X,1p,2E13.4,5x,2E13.4)') | |
4325 | & y1,F_inp_1(i),y2,F_inp_2(i) | |
4326 | ||
4327 | 100 CONTINUE | |
4328 | ||
4329 | call pho_samp1d(-1,X_inp_1,F_inp_1,F_int_1,Max_tab,X_out_1) | |
4330 | call pho_samp1d(-1,X_inp_2,F_inp_2,F_int_2,Max_tab,X_out_2) | |
4331 | ||
4332 | C initialize event generator | |
4333 | ||
4334 | C photon 1 | |
4335 | EGAM = YMAX1*EE1 | |
4336 | P1(1) = 0.D0 | |
4337 | P1(2) = 0.D0 | |
4338 | P1(3) = EGAM | |
4339 | P1(4) = EGAM | |
4340 | C photon 2 | |
4341 | EGAM = YMAX2*EE2 | |
4342 | P2(1) = 0.D0 | |
4343 | P2(2) = 0.D0 | |
4344 | P2(3) = -EGAM | |
4345 | P2(4) = EGAM | |
4346 | CALL PHO_SETPAR(1,22,0,0.D0) | |
4347 | CALL PHO_SETPAR(2,22,0,0.D0) | |
4348 | CALL PHO_EVENT(-1,P1,P2,SIGMAX,IREJ) | |
4349 | CALL PHO_PHIST(-1,SIGMAX) | |
4350 | CALL PHO_LHIST(-1,SIGMAX) | |
4351 | ||
4352 | C generation of events | |
4353 | AY1 = 0.D0 | |
4354 | AY2 = 0.D0 | |
4355 | AYS1 = 0.D0 | |
4356 | AYS2 = 0.D0 | |
4357 | NITER = NEVENT | |
4358 | ITRY = 0 | |
4359 | ITRW = 0 | |
4360 | DO 200 I=1,NITER | |
4361 | 150 CONTINUE | |
4362 | ITRY = ITRY+1 | |
4363 | 175 CONTINUE | |
4364 | ITRW = ITRW+1 | |
4365 | ||
4366 | call pho_samp1d(1,X_inp_1,F_inp_1,F_int_1,Max_tab,X_out_1) | |
4367 | call pho_samp1d(1,X_inp_2,F_inp_2,F_int_2,Max_tab,X_out_2) | |
4368 | ||
4369 | g_1 = sqrt(max(0.D0,X_1/(X_out_1+1.D-6)-X_1-1.D0)) | |
4370 | g_2 = sqrt(max(0.D0,X_2/(X_out_2+1.D-6)-X_2-1.D0)) | |
4371 | if(abs(1.D0-A).lt.1.D-3) then | |
4372 | v = rho**2/4.D0*g_1*g_2 | |
4373 | Wght = exp(-rho**2/8.D0*(g_1-g_2)**2)*pho_ExpBessI0(v) | |
4374 | else | |
4375 | Nint = 16 | |
4376 | call pho_gauset(0.D0,Pi2,Nint,Xgrid,Wgrid) | |
4377 | A2 = A**2 | |
4378 | fac = rho**2/(4.D0*(1.D0+A2)) | |
4379 | Wght = 0.D0 | |
4380 | do i1=1,Nint | |
4381 | phi_1 = Xgrid(i1) | |
4382 | do i2=1,Nint | |
4383 | phi_2 = Xgrid(i2) | |
4384 | Wght = Wght | |
4385 | & +exp(-fac*(A2*(g_1*cos(phi_1)+g_2*cos(phi_2))**2 | |
4386 | & +(g_1*sin(phi_1)+g_2*sin(phi_2))**2)) | |
4387 | & *Wgrid(i1)*Wgrid(i2) | |
4388 | enddo | |
4389 | enddo | |
4390 | Wght = Wght/Pi2**2 | |
4391 | endif | |
4392 | ||
4393 | IF(Wght.GT.1.D0) THEN | |
4394 | WRITE(LO,'(1X,A,5E11.4)') | |
4395 | & 'PHO_GGBLSR:WEIGHT ERROR:',Y1,Y2,Wght | |
4396 | ENDIF | |
4397 | IF(DT_RNDM(dum).GT.Wght) GOTO 175 | |
4398 | ||
4399 | Y1 = X_out_1 | |
4400 | Y2 = X_out_2 | |
4401 | ||
4402 | Q2P1 = 0.D0 | |
4403 | Q2P2 = 0.D0 | |
4404 | GYY(1) = Y1 | |
4405 | GQ2(1) = Q2P1 | |
4406 | GYY(2) = Y2 | |
4407 | GQ2(2) = Q2P2 | |
4408 | C incoming electron 1 | |
4409 | PINI(1,1) = 0.D0 | |
4410 | PINI(2,1) = 0.D0 | |
4411 | PINI(3,1) = EE1 | |
4412 | PINI(4,1) = EE1 | |
4413 | PINI(5,1) = 0.D0 | |
4414 | C outgoing electron 1 | |
4415 | YQ2 = SQRT((1.D0-Y1)*Q2P2) | |
4416 | Q2E = Q2P1/(4.D0*EE1) | |
4417 | E1Y = EE1*(1.D0-Y1) | |
4418 | CALL PHO_SFECFE(SIF,COF) | |
4419 | PFIN(1,1) = YQ2*COF | |
4420 | PFIN(2,1) = YQ2*SIF | |
4421 | PFIN(3,1) = E1Y-Q2E | |
4422 | PFIN(4,1) = E1Y+Q2E | |
4423 | PFIN(5,1) = 0.D0 | |
4424 | C photon 1 | |
4425 | P1(1) = -PFIN(1,1) | |
4426 | P1(2) = -PFIN(2,1) | |
4427 | P1(3) = PINI(3,1)-PFIN(3,1) | |
4428 | P1(4) = PINI(4,1)-PFIN(4,1) | |
4429 | C incoming electron 2 | |
4430 | PINI(1,2) = 0.D0 | |
4431 | PINI(2,2) = 0.D0 | |
4432 | PINI(3,2) = -EE2 | |
4433 | PINI(4,2) = EE2 | |
4434 | PINI(5,2) = 0.D0 | |
4435 | C outgoing electron 2 | |
4436 | YQ2 = SQRT((1.D0-Y2)*Q2P2) | |
4437 | Q2E = Q2P2/(4.D0*EE2) | |
4438 | E1Y = EE2*(1.D0-Y2) | |
4439 | CALL PHO_SFECFE(SIF,COF) | |
4440 | PFIN(1,2) = YQ2*COF | |
4441 | PFIN(2,2) = YQ2*SIF | |
4442 | PFIN(3,2) = -E1Y+Q2E | |
4443 | PFIN(4,2) = E1Y+Q2E | |
4444 | PFIN(5,2) = 0.D0 | |
4445 | C photon 2 | |
4446 | P2(1) = -PFIN(1,2) | |
4447 | P2(2) = -PFIN(2,2) | |
4448 | P2(3) = PINI(3,2)-PFIN(3,2) | |
4449 | P2(4) = PINI(4,2)-PFIN(4,2) | |
4450 | C ECMS cut | |
4451 | GGECM = (P1(4)+P2(4))**2-(P1(1)+P2(1))**2 | |
4452 | & -(P1(2)+P2(2))**2-(P1(3)+P2(3))**2 | |
4453 | IF(GGECM.LT.0.1D0) GOTO 175 | |
4454 | GGECM = SQRT(GGECM) | |
4455 | IF((GGECM.LT.ECMIN).OR.(GGECM.GT.ECMAX)) GOTO 175 | |
4456 | ||
4457 | PGAM(1,1) = P1(1) | |
4458 | PGAM(2,1) = P1(2) | |
4459 | PGAM(3,1) = P1(3) | |
4460 | PGAM(4,1) = P1(4) | |
4461 | PGAM(5,1) = 0.D0 | |
4462 | PGAM(1,2) = P2(1) | |
4463 | PGAM(2,2) = P2(2) | |
4464 | PGAM(3,2) = P2(3) | |
4465 | PGAM(4,2) = P2(4) | |
4466 | PGAM(5,2) = 0.D0 | |
4467 | C photon helicities | |
4468 | IGHEL(1) = 1 | |
4469 | IGHEL(2) = 1 | |
4470 | C cut given by user | |
4471 | CALL PHO_PRESEL(5,IREJ) | |
4472 | IF(IREJ.NE.0) GOTO 175 | |
4473 | C event generation | |
4474 | CALL PHO_EVENT(1,P1,P2,SIGCUR,IREJ) | |
4475 | IF(IREJ.NE.0) GOTO 150 | |
4476 | C statistics | |
4477 | AY1 = AY1+Y1 | |
4478 | AYS1 = AYS1+Y1*Y1 | |
4479 | AY2 = AY2+Y2 | |
4480 | AYS2 = AYS2+Y2*Y2 | |
4481 | C histograms | |
4482 | CALL PHO_PHIST(1,HSWGHT(0)) | |
4483 | CALL PHO_LHIST(1,HSWGHT(0)) | |
4484 | 200 CONTINUE | |
4485 | ||
4486 | WGY = DBLE(ITRY)/DBLE(ITRW) | |
4487 | AY1 = AY1/DBLE(NITER) | |
4488 | AYS1 = AYS1/DBLE(NITER) | |
4489 | DAY1 = SQRT((AYS1-AY1**2)/DBLE(NITER)) | |
4490 | AY2 = AY2/DBLE(NITER) | |
4491 | AYS2 = AYS2/DBLE(NITER) | |
4492 | DAY2 = SQRT((AYS2-AY2**2)/DBLE(NITER)) | |
4493 | WEIGHT = WGY*SIGMAX*DBLE(NITER)/DBLE(ITRY) | |
4494 | C output of statistics, histograms | |
4495 | WRITE(LO,'(//1X,A,/1X,A,1PE12.3,A,/1X,A)') | |
4496 | &'=========================================================', | |
4497 | &' ***** simulated cross section: ',WEIGHT,' mb *****', | |
4498 | &'=========================================================' | |
4499 | WRITE(LO,'(//1X,A,3I10)') | |
4500 | & 'PHO_GGBLSR:SUMMARY:NITER,ITRY,ITRW',NITER,ITRY,ITRW | |
4501 | WRITE(LO,'(1X,A,1P2E12.4)') 'EFFECTIVE WEIGHT (FLUX,TOTAL)', | |
4502 | & WGY,WEIGHT | |
4503 | WRITE(LO,'(1X,A,2F10.5)') 'PHO_GGBLSR:AVERAGE Y1,DY1 ',AY1,DAY1 | |
4504 | WRITE(LO,'(1X,A,2F10.5)') 'PHO_GGBLSR:AVERAGE Y2,DY2 ',AY2,DAY2 | |
4505 | ||
4506 | CALL PHO_EVENT(-2,P1,P2,WEIGHT,IREJ) | |
4507 | IF(NITER.GT.1) THEN | |
4508 | CALL PHO_PHIST(-2,WEIGHT) | |
4509 | CALL PHO_LHIST(-2,WEIGHT) | |
4510 | ELSE | |
4511 | WRITE(LO,'(1X,A,I4)') 'PHO_GGBLSR:NO OUTPUT OF HISTOGRAMS',NITER | |
4512 | ENDIF | |
4513 | ||
4514 | END | |
4515 | ||
4516 | *$ CREATE pho_samp1d.FOR | |
4517 | *COPY pho_samp1d | |
4518 | CDECK ID>, pho_samp1d | |
4519 | SUBROUTINE pho_samp1d(Imode,X_inp,F_inp,F_int,N_dim,X_out) | |
4520 | C*********************************************************************** | |
4521 | C | |
4522 | C Monte Carlo sampling from arbitrary 1d distribution | |
4523 | C (linear interpolation to improve reproduction of initial function) | |
4524 | C | |
4525 | C input: Imode -1 initialization | |
4526 | C 1 sampling (after initialization) | |
4527 | C X_inp(N_dim) array with x values | |
4528 | C F_inp(N_dim) array with function values | |
4529 | C F_int(N_dim) array with integral | |
4530 | C | |
4531 | C output: X_out sampled value (Imode=1) | |
4532 | C | |
4533 | C (R.E. 10/99) | |
4534 | C | |
4535 | C*********************************************************************** | |
4536 | implicit none | |
4537 | save | |
4538 | ||
4539 | C input/output channels | |
4540 | INTEGER LI,LO | |
4541 | COMMON /POINOU/ LI,LO | |
4542 | ||
4543 | integer Imode,N_dim | |
4544 | double precision X_inp,F_inp,F_int,X_out | |
4545 | dimension X_inp(N_dim),F_inp(N_dim),F_int(N_dim) | |
4546 | ||
4547 | C local variables | |
4548 | integer i | |
4549 | double precision dum,xi,a,b | |
4550 | ||
4551 | C external functions | |
4552 | double precision DT_RNDM | |
4553 | external DT_RNDM | |
4554 | ||
4555 | if(Imode.eq.-1) then | |
4556 | ||
4557 | C initialization | |
4558 | ||
4559 | F_int(1) = 0.D0 | |
4560 | do i=2,N_dim | |
4561 | F_int(i) = F_int(i-1) | |
4562 | & +0.5D0*(F_inp(i)+F_inp(i-1))*(X_inp(i)-X_inp(i-1)) | |
4563 | enddo | |
4564 | ||
4565 | else if(Imode.eq.1) then | |
4566 | ||
4567 | C sample from previously calculated integral | |
4568 | ||
4569 | xi = DT_RNDM(dum)*F_int(N_dim) | |
4570 | ||
4571 | do i=2,N_dim | |
4572 | if(xi.lt.F_int(i)) then | |
4573 | a = (F_inp(i)-F_inp(i-1))/(X_inp(i)-X_inp(i-1)) | |
4574 | b = F_inp(i)-a*X_inp(i) | |
4575 | xi = xi-F_int(i-1)+0.5D0*a*X_inp(i-1)**2+b*X_inp(i-1) | |
4576 | X_out = (sqrt(b**2+2.D0*a*xi)-b)/a | |
4577 | return | |
4578 | endif | |
4579 | enddo | |
4580 | X_out = X_inp(N_dim) | |
4581 | ||
4582 | else | |
4583 | ||
4584 | C invalid option Imode | |
4585 | ||
4586 | WRITE(LO,'(1x,a,i6)') 'PHO_SAMP1D: invalid option Imode: ',Imode | |
4587 | X_out = 0.D0 | |
4588 | ||
4589 | endif | |
4590 | ||
4591 | END | |
4592 | ||
4593 | *$ CREATE pho_ExpBessI0.FOR | |
4594 | *COPY pho_ExpBessI0 | |
4595 | CDECK ID>, pho_ExpBessI0 | |
4596 | DOUBLE PRECISION FUNCTION pho_ExpBessI0(X) | |
4597 | C********************************************************************** | |
4598 | C | |
4599 | C Bessel Function I0 times exponential function from neg. arg. | |
4600 | C (defined for pos. arguments only) | |
4601 | C | |
4602 | C********************************************************************** | |
4603 | IMPLICIT DOUBLE PRECISION (A-H,O-Z) | |
4604 | SAVE | |
4605 | ||
4606 | AX = ABS(X) | |
4607 | IF (AX .LT. 3.75D0) THEN | |
4608 | Y = (X/3.75D0)**2 | |
4609 | pho_ExpBessI0 = | |
4610 | & (1.0D0+Y*(3.5156229D0+Y*(3.0899424D0+Y*(1.2067492D0 | |
4611 | & +Y*(0.2659732D0+Y*(0.360768D-1+Y*0.45813D-2))))))*EXP(-AX) | |
4612 | ELSE | |
4613 | Y = 3.75D0/AX | |
4614 | pho_ExpBessI0 = | |
4615 | & (1.D0/SQRT(AX))*(0.39894228D0+Y*(0.1328592D-1 | |
4616 | & +Y*(0.225319D-2+Y*(-0.157565D-2+Y*(0.916281D-2 | |
4617 | & +Y*(-0.2057706D-1+Y*(0.2635537D-1+Y*(-0.1647633D-1 | |
4618 | & +Y*0.392377D-2)))))))) | |
4619 | ENDIF | |
4620 | ||
4621 | END | |
4622 | ||
4623 | *$ CREATE PHO_GGBEAM.FOR | |
4624 | *COPY PHO_GGBEAM | |
4625 | CDECK ID>, PHO_GGBEAM | |
4626 | SUBROUTINE PHO_GGBEAM(NEVENT,EE,YPSI,SIGX,SIGY,SIGZ,AEB) | |
4627 | C********************************************************************** | |
4628 | C | |
4629 | C interface to call PHOJET (variable energy run) for | |
4630 | C gamma-gamma collisions via beamstrahlung | |
4631 | C | |
4632 | C input: EE LAB system energy of electron/positron | |
4633 | C YPSI beamstrahlung parameter | |
4634 | C SIGX,Y transverse bunch dimensions | |
4635 | C SIGZ longitudinal bunch dimension | |
4636 | C AEB number of electrons/positrons in a bunch | |
4637 | C NEVENT number of events to generate | |
4638 | C from /LEPCUT/: | |
4639 | C YMIN1 lower limit of Y | |
4640 | C (energy fraction taken by photon from electron) | |
4641 | C YMAX1 upper cutoff for Y, necessary to avoid | |
4642 | C underflows | |
4643 | C | |
4644 | C********************************************************************** | |
4645 | IMPLICIT DOUBLE PRECISION (A-H,O-Z) | |
4646 | SAVE | |
4647 | ||
4648 | PARAMETER ( DEPS = 1.D-20, | |
4649 | & PI = 3.14159265359D0 ) | |
4650 | ||
4651 | C input/output channels | |
4652 | INTEGER LI,LO | |
4653 | COMMON /POINOU/ LI,LO | |
4654 | C event debugging information | |
4655 | INTEGER NMAXD | |
4656 | PARAMETER (NMAXD=100) | |
4657 | INTEGER IDEB,KSPOM,KHPOM,KSREG,KHDIR,KACCEP,KSTRG,KHTRG,KSLOO, | |
4658 | & KHLOO,KSDPO,KHDPO,KEVENT,KSOFT,KHARD | |
4659 | COMMON /PODEBG/ IDEB(NMAXD),KSPOM,KHPOM,KSREG,KHDIR,KACCEP,KSTRG, | |
4660 | & KHTRG,KSLOO,KHLOO,KSDPO,KHDPO,KEVENT,KSOFT,KHARD | |
4661 | C photon flux kinematics and cuts | |
4662 | DOUBLE PRECISION ECMIN,ECMAX,EEMIN1,EEMIN2, | |
4663 | & YMIN1,YMAX1,YMIN2,YMAX2, | |
4664 | & Q2MIN1,Q2MAX1,Q2MIN2,Q2MAX2, | |
4665 | & THMIN1,THMAX1,THMIN2,THMAX2 | |
4666 | INTEGER ITAG1,ITAG2 | |
4667 | COMMON /POFCUT/ ECMIN,ECMAX,EEMIN1,EEMIN2, | |
4668 | & YMIN1,YMAX1,YMIN2,YMAX2, | |
4669 | & Q2MIN1,Q2MAX1,Q2MIN2,Q2MAX2, | |
4670 | & THMIN1,THMAX1,THMIN2,THMAX2, | |
4671 | & ITAG1,ITAG2 | |
4672 | C gamma-lepton or gamma-hadron vertex information | |
4673 | INTEGER IGHEL,IDPSRC,IDBSRC | |
4674 | DOUBLE PRECISION PINI,PFIN,PGAM,GYY,GQ2,GGECM,GAIMP,PFTHE,PFPHI, | |
4675 | & RADSRC,AMSRC,GAMSRC | |
4676 | COMMON /POFSRC/ PINI(5,2),PFIN(5,2),PGAM(5,2),IGHEL(2), | |
4677 | & GYY(2),GQ2(2),GGECM,GAIMP(2),PFTHE(2),PFPHI(2), | |
4678 | & IDPSRC(2),IDBSRC(2),RADSRC(2),AMSRC(2),GAMSRC(2) | |
4679 | C nucleon-nucleus / nucleus-nucleus interface to DPMJET | |
4680 | INTEGER IDEQP,IDEQB,IHFLD,IHFLS | |
4681 | DOUBLE PRECISION ECMN,PCMN,SECM,SPCM,XPSUB,XTSUB | |
4682 | COMMON /POHDFL/ ECMN,PCMN,SECM,SPCM,XPSUB,XTSUB, | |
4683 | & IDEQP(2),IDEQB(2),IHFLD(2,2),IHFLS(2) | |
4684 | C event weights and generated cross section | |
4685 | INTEGER IPOWGC,ISWCUT,IVWGHT | |
4686 | DOUBLE PRECISION SIGGEN,HSWGHT,HSWCUT,EVWGHT | |
4687 | COMMON /POWGHT/ SIGGEN(4),HSWGHT(0:10),HSWCUT(20),EVWGHT(0:10), | |
4688 | & IPOWGC(0:10),ISWCUT(20),IVWGHT(0:10) | |
4689 | ||
4690 | PARAMETER (Max_tab=100) | |
4691 | DIMENSION P1(4),P2(4),TABCU(0:Max_tab),TABYL(0:Max_tab) | |
4692 | C | |
4693 | WRITE(LO,'(//1X,A,I10)') 'PHO_GGBEAM: events to process',NEVENT | |
4694 | C electron data | |
4695 | RE = 2.818D-12 | |
4696 | ELEM = 0.512D-03 | |
4697 | IDPSRC(1) = 0 | |
4698 | IDBSRC(1) = 0 | |
4699 | IDPSRC(2) = 0 | |
4700 | IDBSRC(2) = 0 | |
4701 | C table of flux function, log interpolation | |
4702 | IF(YPSI.LE.0.D0) THEN | |
4703 | YPSI = 5.D0*RE**2*EE*AEB*137.D0/(6.D0*SIGZ*(SIGX+SIGY)*ELEM) | |
4704 | ENDIF | |
4705 | WRITE(LO,'(/1X,A,E12.4)') | |
4706 | & 'PHO_GGBEAM: beamstrahlung parameter:',YPSI | |
4707 | WRITE(LO,'(/1X,A,2E12.4)') | |
4708 | & 'PHO_GGBEAM: sigma-z,ne-bunch:',SIGZ,AEB | |
4709 | TT = 2.D0/3.D0 | |
4710 | OT = 1.D0/3.D0 | |
4711 | C GAOT = DGAMMA(OT) | |
4712 | GAOT = 2.6789385347D0 | |
4713 | AKAP = TT/YPSI | |
4714 | WW = 1.D0/(6.D0*SQRT(AKAP)) | |
4715 | ANGAM = 5.D0*SIGZ*ELEM/(137.D0**2*2.D0*RE*EE) | |
4716 | & *YPSI/SQRT(1.D0+YPSI**TT) | |
4717 | ||
4718 | YMIN = YMIN1 | |
4719 | YMAX = MIN(YMAX1,0.9D0) | |
4720 | TABCU(0) = 0.D0 | |
4721 | TABYL(0) = LOG(YMIN) | |
4722 | DELLY = LOG(YMAX/YMIN)/DBLE(Max_tab-1) | |
4723 | FLUX = 0.D0 | |
4724 | IF(IDEB(30).GE.1) WRITE(LO,'(1X,A,I5)') | |
4725 | & 'PHO_GGBEAM: table of photon flux',Max_tab | |
4726 | DO 100 I=1,Max_tab | |
4727 | Y = EXP(TABYL(0)+DELLY*DBLE(I-1)) | |
4728 | GG = 1.D0-0.5D0*(1-Y)**TT*(1.D0-Y+(1.D0+Y)*SQRT(1.D0+YPSI**TT)) | |
4729 | FF = AKAP**OT/GAOT/Y**TT/(1.D0-Y)**OT*EXP(-AKAP*Y/(1.D0-Y)) | |
4730 | & *((1.D0-WW)/GG*(1.D0-(1.D0-EXP(-ANGAM*GG))/(ANGAM*GG)) | |
4731 | & +WW*(1.D0-(1.D0-EXP(-ANGAM))/ANGAM)) | |
4732 | TABCU(I) = TABCU(I-1)+FF*Y | |
4733 | TABYL(I) = LOG(Y) | |
4734 | FLUX = FLUX+Y*FF | |
4735 | IF(IDEB(30).GE.1) WRITE(LO,'(5X,2E15.4)') Y,FF | |
4736 | 100 CONTINUE | |
4737 | FLUX = FLUX*DELLY | |
4738 | IF(IDEB(30).GE.1) WRITE(LO,'(1X,A,E12.4)') | |
4739 | & 'PHO_GGBEAM: integrated flux (one side):',FLUX | |
4740 | ||
4741 | EE1 = EE | |
4742 | EE2 = EE | |
4743 | C photon 1 | |
4744 | EGAM = YMAX*EE | |
4745 | P1(1) = 0.D0 | |
4746 | P1(2) = 0.D0 | |
4747 | P1(3) = EGAM | |
4748 | P1(4) = EGAM | |
4749 | C photon 2 | |
4750 | EGAM = YMAX*EE | |
4751 | P2(1) = 0.D0 | |
4752 | P2(2) = 0.D0 | |
4753 | P2(3) = -EGAM | |
4754 | P2(4) = EGAM | |
4755 | CALL PHO_SETPAR(1,22,0,0.D0) | |
4756 | CALL PHO_SETPAR(2,22,0,0.D0) | |
4757 | CALL PHO_EVENT(-1,P1,P2,SIGMAX,IREJ) | |
4758 | CALL PHO_PHIST(-1,SIGMAX) | |
4759 | CALL PHO_LHIST(-1,SIGMAX) | |
4760 | ||
4761 | C generation of events | |
4762 | AY1 = 0.D0 | |
4763 | AY2 = 0.D0 | |
4764 | AYS1 = 0.D0 | |
4765 | AYS2 = 0.D0 | |
4766 | NITER = NEVENT | |
4767 | ITRY = 0 | |
4768 | ITRW = 0 | |
4769 | DO 200 I=1,NITER | |
4770 | 150 CONTINUE | |
4771 | ITRY = ITRY+1 | |
4772 | 175 CONTINUE | |
4773 | ITRW = ITRW+1 | |
4774 | XI = DT_RNDM(AY1)*TABCU(Max_tab) | |
4775 | DO 110 K=1,Max_tab | |
4776 | IF(TABCU(K).GE.XI) THEN | |
4777 | Y1 = DELLY/(TABCU(K)-TABCU(K-1))*(XI-TABCU(K-1))+TABYL(K-1) | |
4778 | Y1 = EXP(Y1) | |
4779 | GOTO 120 | |
4780 | ENDIF | |
4781 | 110 CONTINUE | |
4782 | Y1 = YMAX | |
4783 | 120 CONTINUE | |
4784 | XI = DT_RNDM(AY2)*TABCU(Max_tab) | |
4785 | DO 130 K=1,Max_tab | |
4786 | IF(TABCU(K).GE.XI) THEN | |
4787 | Y2 = DELLY/(TABCU(K)-TABCU(K-1))*(XI-TABCU(K-1))+TABYL(K-1) | |
4788 | Y2 = EXP(Y2) | |
4789 | GOTO 140 | |
4790 | ENDIF | |
4791 | 130 CONTINUE | |
4792 | Y2 = YMAX | |
4793 | 140 CONTINUE | |
4794 | Q2P1 = 0.D0 | |
4795 | Q2P2 = 0.D0 | |
4796 | GYY(1) = Y1 | |
4797 | GQ2(1) = Q2P1 | |
4798 | GYY(2) = Y2 | |
4799 | GQ2(2) = Q2P2 | |
4800 | C incoming electron 1 | |
4801 | PINI(1,1) = 0.D0 | |
4802 | PINI(2,1) = 0.D0 | |
4803 | PINI(3,1) = EE1 | |
4804 | PINI(4,1) = EE1 | |
4805 | PINI(5,1) = 0.D0 | |
4806 | C outgoing electron 1 | |
4807 | YQ2 = SQRT((1.D0-Y1)*Q2P2) | |
4808 | Q2E = Q2P1/(4.D0*EE1) | |
4809 | E1Y = EE1*(1.D0-Y1) | |
4810 | CALL PHO_SFECFE(SIF,COF) | |
4811 | PFIN(1,1) = YQ2*COF | |
4812 | PFIN(2,1) = YQ2*SIF | |
4813 | PFIN(3,1) = E1Y-Q2E | |
4814 | PFIN(4,1) = E1Y+Q2E | |
4815 | PFIN(5,1) = 0.D0 | |
4816 | C photon 1 | |
4817 | P1(1) = -PFIN(1,1) | |
4818 | P1(2) = -PFIN(2,1) | |
4819 | P1(3) = PINI(3,1)-PFIN(3,1) | |
4820 | P1(4) = PINI(4,1)-PFIN(4,1) | |
4821 | C incoming electron 2 | |
4822 | PINI(1,2) = 0.D0 | |
4823 | PINI(2,2) = 0.D0 | |
4824 | PINI(3,2) = -EE2 | |
4825 | PINI(4,2) = EE2 | |
4826 | PINI(5,2) = 0.D0 | |
4827 | C outgoing electron 2 | |
4828 | YQ2 = SQRT((1.D0-Y2)*Q2P2) | |
4829 | Q2E = Q2P2/(4.D0*EE2) | |
4830 | E1Y = EE2*(1.D0-Y2) | |
4831 | CALL PHO_SFECFE(SIF,COF) | |
4832 | PFIN(1,2) = YQ2*COF | |
4833 | PFIN(2,2) = YQ2*SIF | |
4834 | PFIN(3,2) = -E1Y+Q2E | |
4835 | PFIN(4,2) = E1Y+Q2E | |
4836 | PFIN(5,2) = 0.D0 | |
4837 | C photon 2 | |
4838 | P2(1) = -PFIN(1,2) | |
4839 | P2(2) = -PFIN(2,2) | |
4840 | P2(3) = PINI(3,2)-PFIN(3,2) | |
4841 | P2(4) = PINI(4,2)-PFIN(4,2) | |
4842 | C ECMS cut | |
4843 | GGECM = (P1(4)+P2(4))**2-(P1(1)+P2(1))**2 | |
4844 | & -(P1(2)+P2(2))**2-(P1(3)+P2(3))**2 | |
4845 | IF(GGECM.LT.0.1D0) GOTO 175 | |
4846 | GGECM = SQRT(GGECM) | |
4847 | IF((GGECM.LT.ECMIN).OR.(GGECM.GT.ECMAX)) GOTO 175 | |
4848 | C | |
4849 | PGAM(1,1) = P1(1) | |
4850 | PGAM(2,1) = P1(2) | |
4851 | PGAM(3,1) = P1(3) | |
4852 | PGAM(4,1) = P1(4) | |
4853 | PGAM(5,1) = 0.D0 | |
4854 | PGAM(1,2) = P2(1) | |
4855 | PGAM(2,2) = P2(2) | |
4856 | PGAM(3,2) = P2(3) | |
4857 | PGAM(4,2) = P2(4) | |
4858 | PGAM(5,2) = 0.D0 | |
4859 | C photon helicities | |
4860 | IGHEL(1) = 1 | |
4861 | IGHEL(2) = 1 | |
4862 | C cut given by user | |
4863 | CALL PHO_PRESEL(5,IREJ) | |
4864 | IF(IREJ.NE.0) GOTO 175 | |
4865 | C event generation | |
4866 | CALL PHO_EVENT(1,P1,P2,SIGCUR,IREJ) | |
4867 | IF(IREJ.NE.0) GOTO 150 | |
4868 | GGECML = LOG(GGECM) | |
4869 | C statistics | |
4870 | AY1 = AY1+Y1 | |
4871 | AYS1 = AYS1+Y1*Y1 | |
4872 | AY2 = AY2+Y2 | |
4873 | AYS2 = AYS2+Y2*Y2 | |
4874 | C histograms | |
4875 | CALL PHO_PHIST(1,HSWGHT(0)) | |
4876 | CALL PHO_LHIST(1,HSWGHT(0)) | |
4877 | 200 CONTINUE | |
4878 | C | |
4879 | WGY = FLUX**2*DBLE(ITRY)/DBLE(ITRW) | |
4880 | AY1 = AY1/DBLE(NITER) | |
4881 | AYS1 = AYS1/DBLE(NITER) | |
4882 | DAY1 = SQRT((AYS1-AY1**2)/DBLE(NITER)) | |
4883 | AY2 = AY2/DBLE(NITER) | |
4884 | AYS2 = AYS2/DBLE(NITER) | |
4885 | DAY2 = SQRT((AYS2-AY2**2)/DBLE(NITER)) | |
4886 | WEIGHT = WGY*SIGMAX*DBLE(NITER)/DBLE(ITRY) | |
4887 | C output of statistics, histograms | |
4888 | WRITE(LO,'(//1X,A,/1X,A,1PE12.3,A,/1X,A)') | |
4889 | &'=========================================================', | |
4890 | &' ***** simulated cross section: ',WEIGHT,' mb *****', | |
4891 | &'=========================================================' | |
4892 | WRITE(LO,'(//1X,A,2I10)') | |
4893 | & 'PHO_GGBEAM:SUMMARY:NITER,ITRY',NITER,ITRY | |
4894 | WRITE(LO,'(1X,A,1P2E12.4)') 'EFFECTIVE WEIGHT (FLUX,TOTAL)', | |
4895 | & WGY,WEIGHT | |
4896 | WRITE(LO,'(1X,A,2F10.5)') 'PHO_GGBEAM:AVERAGE Y1,DY1 ',AY1,DAY1 | |
4897 | WRITE(LO,'(1X,A,2F10.5)') 'PHO_GGBEAM:AVERAGE Y2,DY2 ',AY2,DAY2 | |
4898 | C | |
4899 | CALL PHO_EVENT(-2,P1,P2,WEIGHT,IREJ) | |
4900 | IF(NITER.GT.1) THEN | |
4901 | CALL PHO_PHIST(-2,WEIGHT) | |
4902 | CALL PHO_LHIST(-2,WEIGHT) | |
4903 | ELSE | |
4904 | WRITE(LO,'(1X,A,I4)') 'PHO_GGBEAM:NO OUTPUT OF HISTOGRAMS',NITER | |
4905 | ENDIF | |
4906 | ||
4907 | END | |
4908 | ||
4909 | *$ CREATE PHO_GGHIOF.FOR | |
4910 | *COPY PHO_GGHIOF | |
4911 | CDECK ID>, PHO_GGHIOF | |
4912 | SUBROUTINE PHO_GGHIOF(NEVENT,EEN,NA,NZ) | |
4913 | C********************************************************************** | |
4914 | C | |
4915 | C interface to call PHOJET (variable energy run) for | |
4916 | C gamma-gamma collisions via heavy ions (form factor approach) | |
4917 | C | |
4918 | C input: EEN LAB system energy per nucleon | |
4919 | C NA atomic number of ion/hadron | |
4920 | C NZ charge number of ion/hadron | |
4921 | C NEVENT number of events to generate | |
4922 | C from /LEPCUT/: | |
4923 | C YMIN1,2 lower limit of Y | |
4924 | C (energy fraction taken by photon from hadron) | |
4925 | C YMAX1,2 upper cutoff for Y, necessary to avoid | |
4926 | C underflows | |
4927 | C Q2MIN1,2 minimum Q**2 of photons (should be set to 0) | |
4928 | C Q2MAX1,2 maximum Q**2 of photons (if necessary, | |
4929 | C corrected according size of hadron) | |
4930 | C | |
4931 | C currently implemented approximation similar to: | |
4932 | C E.Papageorgiu PhysLettB250(1990)155 | |
4933 | C | |
4934 | C********************************************************************** | |
4935 | IMPLICIT DOUBLE PRECISION (A-H,O-Z) | |
4936 | SAVE | |
4937 | ||
4938 | PARAMETER ( PI = 3.14159265359D0 ) | |
4939 | ||
4940 | C input/output channels | |
4941 | INTEGER LI,LO | |
4942 | COMMON /POINOU/ LI,LO | |
4943 | C model switches and parameters | |
4944 | CHARACTER*8 MDLNA | |
4945 | INTEGER ISWMDL,IPAMDL | |
4946 | DOUBLE PRECISION PARMDL | |
4947 | COMMON /POMDLS/ MDLNA(50),ISWMDL(50),PARMDL(400),IPAMDL(400) | |
4948 | C event debugging information | |
4949 | INTEGER NMAXD | |
4950 | PARAMETER (NMAXD=100) | |
4951 | INTEGER IDEB,KSPOM,KHPOM,KSREG,KHDIR,KACCEP,KSTRG,KHTRG,KSLOO, | |
4952 | & KHLOO,KSDPO,KHDPO,KEVENT,KSOFT,KHARD | |
4953 | COMMON /PODEBG/ IDEB(NMAXD),KSPOM,KHPOM,KSREG,KHDIR,KACCEP,KSTRG, | |
4954 | & KHTRG,KSLOO,KHLOO,KSDPO,KHDPO,KEVENT,KSOFT,KHARD | |
4955 | C photon flux kinematics and cuts | |
4956 | DOUBLE PRECISION ECMIN,ECMAX,EEMIN1,EEMIN2, | |
4957 | & YMIN1,YMAX1,YMIN2,YMAX2, | |
4958 | & Q2MIN1,Q2MAX1,Q2MIN2,Q2MAX2, | |
4959 | & THMIN1,THMAX1,THMIN2,THMAX2 | |
4960 | INTEGER ITAG1,ITAG2 | |
4961 | COMMON /POFCUT/ ECMIN,ECMAX,EEMIN1,EEMIN2, | |
4962 | & YMIN1,YMAX1,YMIN2,YMAX2, | |
4963 | & Q2MIN1,Q2MAX1,Q2MIN2,Q2MAX2, | |
4964 | & THMIN1,THMAX1,THMIN2,THMAX2, | |
4965 | & ITAG1,ITAG2 | |
4966 | C gamma-lepton or gamma-hadron vertex information | |
4967 | INTEGER IGHEL,IDPSRC,IDBSRC | |
4968 | DOUBLE PRECISION PINI,PFIN,PGAM,GYY,GQ2,GGECM,GAIMP,PFTHE,PFPHI, | |
4969 | & RADSRC,AMSRC,GAMSRC | |
4970 | COMMON /POFSRC/ PINI(5,2),PFIN(5,2),PGAM(5,2),IGHEL(2), | |
4971 | & GYY(2),GQ2(2),GGECM,GAIMP(2),PFTHE(2),PFPHI(2), | |
4972 | & IDPSRC(2),IDBSRC(2),RADSRC(2),AMSRC(2),GAMSRC(2) | |
4973 | C nucleon-nucleus / nucleus-nucleus interface to DPMJET | |
4974 | INTEGER IDEQP,IDEQB,IHFLD,IHFLS | |
4975 | DOUBLE PRECISION ECMN,PCMN,SECM,SPCM,XPSUB,XTSUB | |
4976 | COMMON /POHDFL/ ECMN,PCMN,SECM,SPCM,XPSUB,XTSUB, | |
4977 | & IDEQP(2),IDEQB(2),IHFLD(2,2),IHFLS(2) | |
4978 | C event weights and generated cross section | |
4979 | INTEGER IPOWGC,ISWCUT,IVWGHT | |
4980 | DOUBLE PRECISION SIGGEN,HSWGHT,HSWCUT,EVWGHT | |
4981 | COMMON /POWGHT/ SIGGEN(4),HSWGHT(0:10),HSWCUT(20),EVWGHT(0:10), | |
4982 | & IPOWGC(0:10),ISWCUT(20),IVWGHT(0:10) | |
4983 | ||
4984 | DIMENSION P1(4),P2(4),BIMP(2,2) | |
4985 | C | |
4986 | WRITE(LO,'(2(/1X,A))') 'PHO_GGHIOF:GAMMA-GAMMA EVENT GENERATION', | |
4987 | & '--------------------------------------' | |
4988 | C hadron size and mass | |
4989 | FM2GEV = 5.07D0 | |
4990 | HIMASS = DBLE(NA)*0.938D0 | |
4991 | HIMA2 = HIMASS**2 | |
4992 | HIRADI = 1.2D0*FM2GEV*DBLE(NA)**0.333 | |
4993 | ALPHA = DBLE(NZ**2)/137.D0 | |
4994 | C correct Q2MAX1,2 according to hadron size | |
4995 | Q2MAXH = 2.D0/HIRADI**2 | |
4996 | Q2MAX1 = MIN(Q2MAX1,Q2MAXH) | |
4997 | Q2MAX2 = MIN(Q2MAX2,Q2MAXH) | |
4998 | IF(Q2MAX1.LT.1.D-20) Q2MAX1 = Q2MAXH | |
4999 | IF(Q2MAX2.LT.1.D-20) Q2MAX2 = Q2MAXH | |
5000 | C total hadron / heavy ion energy | |
5001 | EE = EEN*DBLE(NA) | |
5002 | GAMMA = EE/HIMASS | |
5003 | C setup /POFSRC/ | |
5004 | GAMSRC(1) = GAMMA | |
5005 | GAMSRC(2) = GAMMA | |
5006 | RADSRC(1) = HIRADI | |
5007 | RADSRC(2) = HIRADI | |
5008 | AMSRC(1) = HIMASS | |
5009 | AMSRC(1) = HIMASS | |
5010 | C kinematic limitations | |
5011 | YMI = (ECMIN/(2.D0*EE))**2 | |
5012 | IF(YMIN1.LT.YMI) THEN | |
5013 | WRITE(LO,'(/1X,A,2E12.5)') | |
5014 | & 'PHO_GGHIOF: ymin1 increased to (old/new)',YMIN1,YMI | |
5015 | YMIN1 = YMI | |
5016 | ELSE IF(YMIN1.GT.YMI) THEN | |
5017 | WRITE(LO,'(/1X,A,/1X,A,E12.5,A,E12.5)') | |
5018 | & 'PHO_GGHIOF:','ECM-CUT CORRESPONDS TO YMIN1 OF',YMI, | |
5019 | & ' INSTEAD OF',YMIN1 | |
5020 | ENDIF | |
5021 | IF(YMIN2.LT.YMI) THEN | |
5022 | WRITE(LO,'(/1X,A,2E12.5)') | |
5023 | & 'PHO_GGHIOF: ymin2 increased to (old/new)',YMIN2,YMI | |
5024 | YMIN2 = YMI | |
5025 | ELSE IF(YMIN2.GT.YMI) THEN | |
5026 | WRITE(LO,'(/1X,A,/1X,A,E12.5,A,E12.5)') | |
5027 | & 'PHO_GGHIOF:','ECM-CUT CORRESPONDS TO YMIN2 OF',YMI, | |
5028 | & ' INSTEAD OF',YMIN2 | |
5029 | ENDIF | |
5030 | C kinematic limitation | |
5031 | Q2LOW1 = MAX(Q2MIN1,HIMA2*YMIN1**2/(1.D0-YMIN1)) | |
5032 | Q2LOW2 = MAX(Q2MIN2,HIMA2*YMIN2**2/(1.D0-YMIN2)) | |
5033 | C debug output | |
5034 | WRITE(LO,'(/6X,A,2I4)') 'MASS NUMBER, CHARGE NUMBER ',NA,NZ | |
5035 | WRITE(LO,'(6X,A,E12.5)') 'HADRON MASS (GeV) ',HIMASS | |
5036 | WRITE(LO,'(6X,A,E12.5)') 'HADRON RADIUS (GeV**-1) ',HIRADI | |
5037 | WRITE(LO,'(6X,A,2E12.5)') 'Q**2 RANGE PHOTON 1 (GEV**2)',Q2LOW1, | |
5038 | & Q2MAX1 | |
5039 | WRITE(LO,'(6X,A,2E12.5)') 'Q**2 RANGE PHOTON 2 (GEV**2)',Q2LOW2, | |
5040 | & Q2MAX2 | |
5041 | WRITE(LO,'(6X,A,2E12.5)') 'Y RANGE PHOTON 1 ',YMIN1, | |
5042 | & YMAX1 | |
5043 | WRITE(LO,'(6X,A,2E12.5)') 'Y RANGE PHOTON 2 ',YMIN2, | |
5044 | & YMAX2 | |
5045 | WRITE(LO,'(6X,A,2E12.5)') 'SQRT(S) PER NUCLEON, TOTAL ', | |
5046 | & 2.D0*EEN,2.D0*EE | |
5047 | WRITE(LO,'(6X,A,I10)') 'EVENTS TO PROCESS ',NEVENT | |
5048 | IF(Q2LOW1.GE.Q2MAX1) THEN | |
5049 | WRITE(LO,'(/1X,A,2E12.4)') | |
5050 | & 'PHO_GGHIOF:ERROR:INCONSISTENT Q**2 RANGE 1',Q2LOW1,Q2MAX1 | |
5051 | CALL PHO_ABORT | |
5052 | ENDIF | |
5053 | IF(Q2LOW2.GE.Q2MAX2) THEN | |
5054 | WRITE(LO,'(/1X,A,2E12.4)') | |
5055 | & 'PHO_GGHIOF:ERROR:INCONSISTENT Q**2 RANGE 2',Q2LOW2,Q2MAX2 | |
5056 | CALL PHO_ABORT | |
5057 | ENDIF | |
5058 | C hadron numbers set to 0 | |
5059 | IDPSRC(1) = 0 | |
5060 | IDPSRC(2) = 0 | |
5061 | IDBSRC(1) = 0 | |
5062 | IDBSRC(2) = 0 | |
5063 | C | |
5064 | Max_tab = 100 | |
5065 | YMAX = YMAX1 | |
5066 | YMIN = YMIN1 | |
5067 | XMAX = LOG(YMAX) | |
5068 | XMIN = LOG(YMIN) | |
5069 | XDEL = XMAX-XMIN | |
5070 | DELLY = LOG(YMAX/YMIN)/DBLE(Max_tab-1) | |
5071 | DO 100 I=1,Max_tab | |
5072 | Y1 = EXP(XMIN+DELLY*DBLE(I-1)) | |
5073 | Q2LOW1 = MAX(Q2MIN1,HIMA2*Y1*Y1/(1.D0-Y1)) | |
5074 | IF(Q2LOW1.GE.Q2MAX1) THEN | |
5075 | WRITE(LO,'(/1X,A,2E12.4)') | |
5076 | & 'PHO_GGHIOF: ymax1 changed from/to',YMAX1,Y1 | |
5077 | YMAX1 = MIN(Y1,YMAX1) | |
5078 | GOTO 101 | |
5079 | ENDIF | |
5080 | 100 CONTINUE | |
5081 | 101 CONTINUE | |
5082 | YMAX = YMAX2 | |
5083 | YMIN = YMIN2 | |
5084 | XMAX = LOG(YMAX) | |
5085 | XMIN = LOG(YMIN) | |
5086 | XDEL = XMAX-XMIN | |
5087 | DELLY = LOG(YMAX/YMIN)/DBLE(Max_tab-1) | |
5088 | DO 102 I=1,Max_tab | |
5089 | Y1 = EXP(XMIN+DELLY*DBLE(I-1)) | |
5090 | Q2LOW2 = MAX(Q2MIN2,HIMA2*Y1*Y1/(1.D0-Y1)) | |
5091 | IF(Q2LOW2.GE.Q2MAX2) THEN | |
5092 | WRITE(LO,'(/1X,A,2E12.4)') | |
5093 | & 'PHO_GGHIOF: ymax2 changed from/to',YMAX2,Y1 | |
5094 | YMAX2 = MIN(Y1,YMAX2) | |
5095 | GOTO 103 | |
5096 | ENDIF | |
5097 | 102 CONTINUE | |
5098 | 103 CONTINUE | |
5099 | YMI = (ECMIN/(2.D0*EE))**2/YMAX2 | |
5100 | IF(YMI.GT.YMIN1) THEN | |
5101 | WRITE(LO,'(/1X,A,2E12.4)') | |
5102 | & 'PHO_GGHIOF: ymin1 changed from/to',YMIN1,YMI | |
5103 | YMIN1 = YMI | |
5104 | ENDIF | |
5105 | YMI = (ECMIN/(2.D0*EE))**2/YMAX1 | |
5106 | IF(YMI.GT.YMIN2) THEN | |
5107 | WRITE(LO,'(/1X,A,2E12.4)') | |
5108 | & 'PHO_GGHIOF: ymin2 changed from/to',YMIN2,YMI | |
5109 | YMIN2 = YMI | |
5110 | ENDIF | |
5111 | C | |
5112 | X1MAX = LOG(YMAX1) | |
5113 | X1MIN = LOG(YMIN1) | |
5114 | X1DEL = X1MAX-X1MIN | |
5115 | X2MAX = LOG(YMAX2) | |
5116 | X2MIN = LOG(YMIN2) | |
5117 | X2DEL = X2MAX-X2MIN | |
5118 | DELLY = LOG(YMAX1/YMIN1)/DBLE(Max_tab-1) | |
5119 | FLUX = 0.D0 | |
5120 | IF(IDEB(30).GE.1) WRITE(LO,'(/1X,A,I5)') | |
5121 | & 'PHO_GGHIOF: table of raw photon flux (side 1)',Max_tab | |
5122 | DO 105 I=1,Max_tab | |
5123 | Y1 = EXP(X1MIN+DELLY*DBLE(I-1)) | |
5124 | Q2LOW1 = MAX(Q2MIN1,HIMA2*Y1*Y1/(1.D0-Y1)) | |
5125 | FF = ((1.D0+(1.D0-Y1)**2)/Y1*LOG(Q2MAX1/Q2LOW1) | |
5126 | & -2.D0*HIMA2*Y1*(1.D0/Q2LOW1-1.D0/Q2MAX1))*ALPHA/(2.D0*PI) | |
5127 | FLUX = FLUX+Y1*FF | |
5128 | IF(IDEB(30).GE.1) WRITE(LO,'(5X,2E15.4)') Y1,FF | |
5129 | 105 CONTINUE | |
5130 | FLUX = FLUX*DELLY | |
5131 | IF(IDEB(30).GE.1) WRITE(LO,'(1X,A,E12.4)') | |
5132 | & 'PHO_GGHIOF: integrated flux (one side):',FLUX | |
5133 | C | |
5134 | Q2LOW1 = MAX(Q2MIN1,HIMA2*YMIN1**2/(1.D0-YMIN1)) | |
5135 | Q2LOW2 = MAX(Q2MIN2,HIMA2*YMIN2**2/(1.D0-YMIN2)) | |
5136 | Y1 = YMIN1 | |
5137 | Y2 = YMIN2 | |
5138 | WGMAX = ((1.D0+(1.D0-Y1)**2)*LOG(Q2MAX1/Q2LOW1) | |
5139 | & -2.D0*HIMA2*Y1*(1.D0/Q2LOW1-1.D0/Q2MAX1)*Y1) | |
5140 | & *((1.D0+(1.D0-Y2)**2)*LOG(Q2MAX2/Q2LOW2) | |
5141 | & -2.D0*HIMA2*Y2*(1.D0/Q2LOW2-1.D0/Q2MAX2)*Y2) | |
5142 | C | |
5143 | C photon 1 | |
5144 | EGAM = YMAX1*EE | |
5145 | P1(1) = 0.D0 | |
5146 | P1(2) = 0.D0 | |
5147 | P1(3) = EGAM | |
5148 | P1(4) = EGAM | |
5149 | C photon 2 | |
5150 | EGAM = YMAX2*EE | |
5151 | P2(1) = 0.D0 | |
5152 | P2(2) = 0.D0 | |
5153 | P2(3) = -EGAM | |
5154 | P2(4) = EGAM | |
5155 | CALL PHO_SETPAR(1,22,0,0.D0) | |
5156 | CALL PHO_SETPAR(2,22,0,0.D0) | |
5157 | CALL PHO_EVENT(-1,P1,P2,SIGMAX,IREJ) | |
5158 | CALL PHO_PHIST(-1,SIGMAX) | |
5159 | CALL PHO_LHIST(-1,SIGMAX) | |
5160 | C | |
5161 | C generation of events, flux calculation | |
5162 | ECFRAC = ECMIN**2/(4.D0*EE*EE) | |
5163 | AY1 = 0.D0 | |
5164 | AY2 = 0.D0 | |
5165 | AYS1 = 0.D0 | |
5166 | AYS2 = 0.D0 | |
5167 | Q21MIN = 1.D30 | |
5168 | Q22MIN = 1.D30 | |
5169 | Q21MAX = 0.D0 | |
5170 | Q22MAX = 0.D0 | |
5171 | Q21AVE = 0.D0 | |
5172 | Q22AVE = 0.D0 | |
5173 | Q21AV2 = 0.D0 | |
5174 | Q22AV2 = 0.D0 | |
5175 | YY1MIN = 1.D30 | |
5176 | YY2MIN = 1.D30 | |
5177 | YY1MAX = 0.D0 | |
5178 | YY2MAX = 0.D0 | |
5179 | NITER = NEVENT | |
5180 | ITRY = 0 | |
5181 | ITRW = 0 | |
5182 | DO 200 I=1,NITER | |
5183 | C sample y1, y2 | |
5184 | 150 CONTINUE | |
5185 | ITRY = ITRY+1 | |
5186 | 175 CONTINUE | |
5187 | ITRW = ITRW+1 | |
5188 | Y1 = EXP(X1DEL*DT_RNDM(AY1)+X1MIN) | |
5189 | Y2 = EXP(X2DEL*DT_RNDM(AY2)+X2MIN) | |
5190 | IF(Y1*Y2.LT.ECFRAC) GOTO 175 | |
5191 | C | |
5192 | Q2LOW1 = MAX(Q2MIN1,HIMA2*Y1**2/(1.D0-Y1)) | |
5193 | IF(Q2LOW1.GE.Q2MAX1) GOTO 175 | |
5194 | Q2LOW2 = MAX(Q2MIN2,HIMA2*Y2**2/(1.D0-Y2)) | |
5195 | IF(Q2LOW2.GE.Q2MAX2) GOTO 175 | |
5196 | Q2LOG1 = LOG(Q2MAX1/Q2LOW1) | |
5197 | Q2LOG2 = LOG(Q2MAX2/Q2LOW2) | |
5198 | WGH = ((1.D0+(1.D0-Y1)**2)*Q2LOG1 | |
5199 | & -2.D0*HIMA2*Y1*(1.D0/Q2LOW1-1.D0/Q2MAX1)*Y1) | |
5200 | & *((1.D0+(1.D0-Y2)**2)*Q2LOG2 | |
5201 | & -2.D0*HIMA2*Y2*(1.D0/Q2LOW2-1.D0/Q2MAX2)*Y2) | |
5202 | IF(WGMAX.LT.WGH) THEN | |
5203 | WRITE(LO,'(1X,A,4E12.5)') | |
5204 | & 'PHO_GGHIOF:WEIGHT ERROR:',Y1,Y2,WGMAX,WGH | |
5205 | ENDIF | |
5206 | IF(DT_RNDM(AYS1)*WGMAX.GT.WGH) GOTO 175 | |
5207 | C sample Q2 | |
5208 | IF(IPAMDL(174).EQ.1) THEN | |
5209 | YEFF = 1.D0+(1.D0-Y1)**2 | |
5210 | 185 CONTINUE | |
5211 | Q2P1 = Q2LOW1*EXP(Q2LOG1*DT_RNDM(Y1)) | |
5212 | WEIGHT = (YEFF-2.D0*(1.D0-Y1)*Q2LOW1/Q2P1)/YEFF | |
5213 | IF(WEIGHT.LT.DT_RNDM(Q2P1)) GOTO 185 | |
5214 | ELSE | |
5215 | Q2P1 = Q2LOW1 | |
5216 | ENDIF | |
5217 | IF(IPAMDL(174).EQ.1) THEN | |
5218 | YEFF = 1.D0+(1.D0-Y2)**2 | |
5219 | 186 CONTINUE | |
5220 | Q2P2 = Q2LOW2*EXP(Q2LOG2*DT_RNDM(Y2)) | |
5221 | WEIGHT = (YEFF-2.D0*(1.D0-Y2)*Q2LOW2/Q2P2)/YEFF | |
5222 | IF(WEIGHT.LT.DT_RNDM(Q2P2)) GOTO 186 | |
5223 | ELSE | |
5224 | Q2P2 = Q2LOW2 | |
5225 | ENDIF | |
5226 | C impact parameter | |
5227 | GAIMP(1) = 1.D0/SQRT(Q2P1) | |
5228 | GAIMP(2) = 1.D0/SQRT(Q2P2) | |
5229 | C form factor (squared) | |
5230 | FF21 = 1.D0 | |
5231 | IF(GAIMP(1).LT.HIRADI) FF21 = 0.D0 | |
5232 | FF22 = 1.D0 | |
5233 | IF(GAIMP(2).LT.HIRADI) FF22 = 0.D0 | |
5234 | IF(DT_RNDM(Q2P1).GE.FF21*FF22) GOTO 175 | |
5235 | C do the hadrons overlap? | |
5236 | IF(ISWMDL(26).GT.0) THEN | |
5237 | DO 190 K=1,2 | |
5238 | CALL PHO_SFECFE(SIF,COF) | |
5239 | BIMP(1,K) = SIF*GAIMP(K) | |
5240 | BIMP(2,K) = COF*GAIMP(K) | |
5241 | 190 CONTINUE | |
5242 | BBABS = SQRT((BIMP(1,1)-BIMP(1,2))**2 | |
5243 | & +(BIMP(2,1)-BIMP(2,2))**2) | |
5244 | IF(BBABS.LT.HIRADI+HIRADI) GOTO 175 | |
5245 | ENDIF | |
5246 | C photon data | |
5247 | GYY(1) = Y1 | |
5248 | GQ2(1) = Q2P1 | |
5249 | GYY(2) = Y2 | |
5250 | GQ2(2) = Q2P2 | |
5251 | C | |
5252 | C incoming hadron 1 | |
5253 | PINI(1,1) = 0.D0 | |
5254 | PINI(2,1) = 0.D0 | |
5255 | PINI(3,1) = EE | |
5256 | PINI(4,1) = EE | |
5257 | PINI(5,1) = 0.D0 | |
5258 | C outgoing hadron 1 | |
5259 | YQ2 = SQRT((1.D0-Y1)*Q2P1) | |
5260 | Q2E = Q2P1/(4.D0*EE) | |
5261 | E1Y = EE*(1.D0-Y1) | |
5262 | CALL PHO_SFECFE(SIF,COF) | |
5263 | PFIN(1,1) = YQ2*COF | |
5264 | PFIN(2,1) = YQ2*SIF | |
5265 | PFIN(3,1) = E1Y-Q2E | |
5266 | PFIN(4,1) = E1Y+Q2E | |
5267 | PFIN(5,1) = 0.D0 | |
5268 | PFPHI(1) = ATAN2(COF,SIF) | |
5269 | PFTHE(1) = ACOS((E1Y-Q2E)/(Q2E+E1Y)) | |
5270 | C photon 1 | |
5271 | P1(1) = -PFIN(1,1) | |
5272 | P1(2) = -PFIN(2,1) | |
5273 | P1(3) = PINI(3,1)-PFIN(3,1) | |
5274 | P1(4) = PINI(4,1)-PFIN(4,1) | |
5275 | C incoming hadron 2 | |
5276 | PINI(1,2) = 0.D0 | |
5277 | PINI(2,2) = 0.D0 | |
5278 | PINI(3,2) = -EE | |
5279 | PINI(4,2) = EE | |
5280 | PINI(5,2) = 0.D0 | |
5281 | C outgoing hadron 2 | |
5282 | YQ2 = SQRT((1.D0-Y2)*Q2P2) | |
5283 | Q2E = Q2P2/(4.D0*EE) | |
5284 | E1Y = EE*(1.D0-Y2) | |
5285 | CALL PHO_SFECFE(SIF,COF) | |
5286 | PFIN(1,2) = YQ2*COF | |
5287 | PFIN(2,2) = YQ2*SIF | |
5288 | PFIN(3,2) = -E1Y+Q2E | |
5289 | PFIN(4,2) = E1Y+Q2E | |
5290 | PFIN(5,2) = 0.D0 | |
5291 | PFPHI(2) = ATAN2(COF,SIF) | |
5292 | PFTHE(2) = ACOS((Q2E-E1Y)/(Q2E+E1Y)) | |
5293 | C photon 2 | |
5294 | P2(1) = -PFIN(1,2) | |
5295 | P2(2) = -PFIN(2,2) | |
5296 | P2(3) = PINI(3,2)-PFIN(3,2) | |
5297 | P2(4) = PINI(4,2)-PFIN(4,2) | |
5298 | C ECMS cut | |
5299 | GGECM = (P1(4)+P2(4))**2-(P1(1)+P2(1))**2 | |
5300 | & -(P1(2)+P2(2))**2-(P1(3)+P2(3))**2 | |
5301 | IF(GGECM.LT.0.1D0) GOTO 175 | |
5302 | GGECM = SQRT(GGECM) | |
5303 | IF((GGECM.LT.ECMIN).OR.(GGECM.GT.ECMAX)) GOTO 175 | |
5304 | C | |
5305 | PGAM(1,1) = P1(1) | |
5306 | PGAM(2,1) = P1(2) | |
5307 | PGAM(3,1) = P1(3) | |
5308 | PGAM(4,1) = P1(4) | |
5309 | PGAM(5,1) = -SQRT(Q2P1) | |
5310 | PGAM(1,2) = P2(1) | |
5311 | PGAM(2,2) = P2(2) | |
5312 | PGAM(3,2) = P2(3) | |
5313 | PGAM(4,2) = P2(4) | |
5314 | PGAM(5,2) = -SQRT(Q2P2) | |
5315 | C photon helicities | |
5316 | IGHEL(1) = 1 | |
5317 | IGHEL(2) = 1 | |
5318 | C cut given by user | |
5319 | CALL PHO_PRESEL(5,IREJ) | |
5320 | IF(IREJ.NE.0) GOTO 175 | |
5321 | C event generation | |
5322 | CALL PHO_EVENT(1,P1,P2,SIGCUR,IREJ) | |
5323 | IF(IREJ.NE.0) GOTO 150 | |
5324 | C statistics | |
5325 | AY1 = AY1+Y1 | |
5326 | AYS1 = AYS1+Y1*Y1 | |
5327 | AY2 = AY2+Y2 | |
5328 | AYS2 = AYS2+Y2*Y2 | |
5329 | Q21MIN = MIN(Q21MIN,Q2P1) | |
5330 | Q22MIN = MIN(Q22MIN,Q2P2) | |
5331 | Q21MAX = MAX(Q21MAX,Q2P1) | |
5332 | Q22MAX = MAX(Q22MAX,Q2P2) | |
5333 | YY1MIN = MIN(YY1MIN,Y1) | |
5334 | YY2MIN = MIN(YY2MIN,Y2) | |
5335 | YY1MAX = MAX(YY1MAX,Y1) | |
5336 | YY2MAX = MAX(YY2MAX,Y2) | |
5337 | Q21AVE = Q21AVE+Q2P1 | |
5338 | Q22AVE = Q22AVE+Q2P2 | |
5339 | Q21AV2 = Q21AV2+Q2P1*Q2P1 | |
5340 | Q22AV2 = Q22AV2+Q2P2*Q2P2 | |
5341 | C histograms | |
5342 | CALL PHO_PHIST(1,HSWGHT(0)) | |
5343 | CALL PHO_LHIST(1,HSWGHT(0)) | |
5344 | 200 CONTINUE | |
5345 | C | |
5346 | WGY = WGMAX*DBLE(ITRY)/DBLE(ITRW)*(ALPHA/(2.D0*PI))**2 | |
5347 | WGY = WGY*LOG(YMAX1/YMIN1)*LOG(YMAX2/YMIN2) | |
5348 | AY1 = AY1/DBLE(NITER) | |
5349 | AYS1 = AYS1/DBLE(NITER) | |
5350 | DAY1 = SQRT((AYS1-AY1**2)/DBLE(NITER)) | |
5351 | AY2 = AY2/DBLE(NITER) | |
5352 | AYS2 = AYS2/DBLE(NITER) | |
5353 | DAY2 = SQRT((AYS2-AY2**2)/DBLE(NITER)) | |
5354 | Q21AVE = Q21AVE/DBLE(NITER) | |
5355 | Q21AV2 = Q21AV2/DBLE(NITER) | |
5356 | Q21AV2 = SQRT((Q21AV2-Q21AVE**2)/DBLE(NITER)) | |
5357 | Q22AVE = Q22AVE/DBLE(NITER) | |
5358 | Q22AV2 = Q22AV2/DBLE(NITER) | |
5359 | Q22AV2 = SQRT((Q22AV2-Q22AVE**2)/DBLE(NITER)) | |
5360 | WEIGHT = WGY*SIGMAX*DBLE(NITER)/DBLE(ITRY) | |
5361 | C output of statistics, histograms | |
5362 | WRITE(LO,'(//1X,A,/1X,A,1PE12.3,A,/1X,A)') | |
5363 | &'=========================================================', | |
5364 | &' ***** simulated cross section: ',WEIGHT,' mb *****', | |
5365 | &'=========================================================' | |
5366 | WRITE(LO,'(//1X,A,3I10)') | |
5367 | & 'PHO_GGHIOF:SUMMARY:NITER,ITRY,ITRW',NITER,ITRY,ITRW | |
5368 | WRITE(LO,'(1X,A,1P2E12.4)') 'EFFECTIVE WEIGHT (FLUX,TOTAL)', | |
5369 | & WGY,WEIGHT | |
5370 | WRITE(LO,'(1X,A,1P2E12.4)') 'AVERAGE Y1,DY1 ', | |
5371 | & AY1,DAY1 | |
5372 | WRITE(LO,'(1X,A,1P2E12.4)') 'AVERAGE Y2,DY2 ', | |
5373 | & AY2,DAY2 | |
5374 | WRITE(LO,'(1X,A,1P2E12.4)') 'SAMPLED Y RANGE PHOTON 1 ', | |
5375 | & YY1MIN,YY1MAX | |
5376 | WRITE(LO,'(1X,A,1P2E12.4)') 'SAMPLED Y RANGE PHOTON 2 ', | |
5377 | & YY2MIN,YY2MAX | |
5378 | WRITE(LO,'(1X,A,1P2E12.4)') 'AVERAGE Q2,DQ2 PHOTON 1 ', | |
5379 | & Q21AVE,Q21AV2 | |
5380 | WRITE(LO,'(1X,A,1P2E12.4)') 'SAMPLED Q2 RANGE PHOTON 1 ', | |
5381 | & Q21MIN,Q21MAX | |
5382 | WRITE(LO,'(1X,A,1P2E12.4)') 'AVERAGE Q2,DQ2 PHOTON 2 ', | |
5383 | & Q22AVE,Q22AV2 | |
5384 | WRITE(LO,'(1X,A,1P2E12.4)') 'SAMPLED Q2 RANGE PHOTON 2 ', | |
5385 | & Q22MIN,Q22MAX | |
5386 | C | |
5387 | CALL PHO_EVENT(-2,P1,P2,WEIGHT,IREJ) | |
5388 | IF(NITER.GT.1) THEN | |
5389 | CALL PHO_PHIST(-2,WEIGHT) | |
5390 | CALL PHO_LHIST(-2,WEIGHT) | |
5391 | ELSE | |
5392 | WRITE(LO,'(1X,A,I4)') 'PHO_GGHIOF:NO OUTPUT OF HISTOGRAMS',NITER | |
5393 | ENDIF | |
5394 | ||
5395 | END | |
5396 | ||
5397 | *$ CREATE PHO_GGHIOG.FOR | |
5398 | *COPY PHO_GGHIOG | |
5399 | CDECK ID>, PHO_GGHIOG | |
5400 | SUBROUTINE PHO_GGHIOG(NEVENT,EEN,NA,NZ) | |
5401 | C********************************************************************** | |
5402 | C | |
5403 | C interface to call PHOJET (variable energy run) for | |
5404 | C gamma-gamma collisions via heavy ions (geometrical approach) | |
5405 | C | |
5406 | C | |
5407 | C input: EEN LAB system energy per nucleon | |
5408 | C NA atomic number of ion/hadron | |
5409 | C NZ charge number of ion/hadron | |
5410 | C NEVENT number of events to generate | |
5411 | C from /LEPCUT/: | |
5412 | C YMIN1,2 lower limit of Y | |
5413 | C (energy fraction taken by photon from hadron) | |
5414 | C YMAX1,2 upper cutoff for Y, necessary to avoid | |
5415 | C underflows | |
5416 | C | |
5417 | C currently implemented approximation similar to: | |
5418 | C | |
5419 | C | |
5420 | C********************************************************************** | |
5421 | IMPLICIT DOUBLE PRECISION (A-H,O-Z) | |
5422 | SAVE | |
5423 | ||
5424 | PARAMETER ( DEPS = 1.D-20, | |
5425 | & PI = 3.14159265359D0 ) | |
5426 | ||
5427 | C input/output channels | |
5428 | INTEGER LI,LO | |
5429 | COMMON /POINOU/ LI,LO | |
5430 | C event debugging information | |
5431 | INTEGER NMAXD | |
5432 | PARAMETER (NMAXD=100) | |
5433 | INTEGER IDEB,KSPOM,KHPOM,KSREG,KHDIR,KACCEP,KSTRG,KHTRG,KSLOO, | |
5434 | & KHLOO,KSDPO,KHDPO,KEVENT,KSOFT,KHARD | |
5435 | COMMON /PODEBG/ IDEB(NMAXD),KSPOM,KHPOM,KSREG,KHDIR,KACCEP,KSTRG, | |
5436 | & KHTRG,KSLOO,KHLOO,KSDPO,KHDPO,KEVENT,KSOFT,KHARD | |
5437 | C photon flux kinematics and cuts | |
5438 | DOUBLE PRECISION ECMIN,ECMAX,EEMIN1,EEMIN2, | |
5439 | & YMIN1,YMAX1,YMIN2,YMAX2, | |
5440 | & Q2MIN1,Q2MAX1,Q2MIN2,Q2MAX2, | |
5441 | & THMIN1,THMAX1,THMIN2,THMAX2 | |
5442 | INTEGER ITAG1,ITAG2 | |
5443 | COMMON /POFCUT/ ECMIN,ECMAX,EEMIN1,EEMIN2, | |
5444 | & YMIN1,YMAX1,YMIN2,YMAX2, | |
5445 | & Q2MIN1,Q2MAX1,Q2MIN2,Q2MAX2, | |
5446 | & THMIN1,THMAX1,THMIN2,THMAX2, | |
5447 | & ITAG1,ITAG2 | |
5448 | C gamma-lepton or gamma-hadron vertex information | |
5449 | INTEGER IGHEL,IDPSRC,IDBSRC | |
5450 | DOUBLE PRECISION PINI,PFIN,PGAM,GYY,GQ2,GGECM,GAIMP,PFTHE,PFPHI, | |
5451 | & RADSRC,AMSRC,GAMSRC | |
5452 | COMMON /POFSRC/ PINI(5,2),PFIN(5,2),PGAM(5,2),IGHEL(2), | |
5453 | & GYY(2),GQ2(2),GGECM,GAIMP(2),PFTHE(2),PFPHI(2), | |
5454 | & IDPSRC(2),IDBSRC(2),RADSRC(2),AMSRC(2),GAMSRC(2) | |
5455 | C nucleon-nucleus / nucleus-nucleus interface to DPMJET | |
5456 | INTEGER IDEQP,IDEQB,IHFLD,IHFLS | |
5457 | DOUBLE PRECISION ECMN,PCMN,SECM,SPCM,XPSUB,XTSUB | |
5458 | COMMON /POHDFL/ ECMN,PCMN,SECM,SPCM,XPSUB,XTSUB, | |
5459 | & IDEQP(2),IDEQB(2),IHFLD(2,2),IHFLS(2) | |
5460 | C event weights and generated cross section | |
5461 | INTEGER IPOWGC,ISWCUT,IVWGHT | |
5462 | DOUBLE PRECISION SIGGEN,HSWGHT,HSWCUT,EVWGHT | |
5463 | COMMON /POWGHT/ SIGGEN(4),HSWGHT(0:10),HSWCUT(20),EVWGHT(0:10), | |
5464 | & IPOWGC(0:10),ISWCUT(20),IVWGHT(0:10) | |
5465 | ||
5466 | PARAMETER (Max_tab=100) | |
5467 | DIMENSION P1(4),P2(4),TABCU(0:Max_tab),TABYL(0:Max_tab) | |
5468 | C | |
5469 | WRITE(LO,'(2(/1X,A))') 'PHO_GGHIOG: gamma-gamma event generation', | |
5470 | & '---------------------------------------' | |
5471 | C hadron size and mass | |
5472 | FM2GEV = 5.07D0 | |
5473 | HIMASS = DBLE(NA)*0.938D0 | |
5474 | HIMA2 = HIMASS**2 | |
5475 | HIRADI = 1.2D0*FM2GEV*DBLE(NA)**0.333 | |
5476 | ALPHA = DBLE(NZ**2)/137.D0 | |
5477 | C total hadron / heavy ion energy | |
5478 | EE = EEN*DBLE(NA) | |
5479 | GAMMA = EE/HIMASS | |
5480 | C setup /POFSRC/ | |
5481 | GAMSRC(1) = GAMMA | |
5482 | GAMSRC(2) = GAMMA | |
5483 | RADSRC(1) = HIRADI | |
5484 | RADSRC(2) = HIRADI | |
5485 | AMSRC(1) = HIMASS | |
5486 | AMSRC(1) = HIMASS | |
5487 | C kinematic limitations | |
5488 | YMI = (ECMIN/(2.D0*EE))**2 | |
5489 | IF(YMIN1.LT.YMI) THEN | |
5490 | WRITE(LO,'(/1X,A,2E12.5)') | |
5491 | & 'PHO_GGHIOG: ymin1 increased to (old/new)',YMIN1,YMI | |
5492 | YMIN1 = YMI | |
5493 | ELSE IF(YMIN1.GT.YMI) THEN | |
5494 | WRITE(LO,'(/1X,A,/1X,A,E12.5,A,E12.5)') | |
5495 | & 'PHO_GGHIOG:','ECM-CUT CORRESPONDS TO YMIN1 OF',YMI, | |
5496 | & ' INSTEAD OF',YMIN1 | |
5497 | ENDIF | |
5498 | IF(YMIN2.LT.YMI) THEN | |
5499 | WRITE(LO,'(/1X,A,2E12.5)') | |
5500 | & 'PHO_GGHIOG: ymin2 increased to (old/new)',YMIN2,YMI | |
5501 | YMIN2 = YMI | |
5502 | ELSE IF(YMIN2.GT.YMI) THEN | |
5503 | WRITE(LO,'(/1X,A,/1X,A,E12.5,A,E12.5)') | |
5504 | & 'PHO_GGHIOG:','ECM-CUT CORRESPONDS TO YMIN2 OF',YMI, | |
5505 | & ' INSTEAD OF',YMIN2 | |
5506 | ENDIF | |
5507 | C debug output | |
5508 | WRITE(LO,'(/6X,A,2I4)') 'MASS NUMBER, CHARGE NUMBER ',NA,NZ | |
5509 | WRITE(LO,'(6X,A,E12.5)') 'HADRON MASS (GeV) ',HIMASS | |
5510 | WRITE(LO,'(6X,A,E12.5)') 'HADRON RADIUS (GeV**-1) ',HIRADI | |
5511 | WRITE(LO,'(6X,A,E12.5)') 'LORENTZ GAMMA ',GAMMA | |
5512 | WRITE(LO,'(6X,A,2E12.5)') 'Y RANGE PHOTON 1 ',YMIN1, | |
5513 | & YMAX1 | |
5514 | WRITE(LO,'(6X,A,2E12.5)') 'Y RANGE PHOTON 2 ',YMIN2, | |
5515 | & YMAX2 | |
5516 | WRITE(LO,'(6X,A,2E12.5)') 'SQRT(S) PER NUCLEON, TOTAL ', | |
5517 | & 2.D0*EEN,2.D0*EE | |
5518 | WRITE(LO,'(6X,A,I10)') 'EVENTS TO PROCESS ',NEVENT | |
5519 | C hadron numbers set to 0 | |
5520 | IDPSRC(1) = 0 | |
5521 | IDBSRC(1) = 0 | |
5522 | IDPSRC(2) = 0 | |
5523 | IDBSRC(2) = 0 | |
5524 | C table of flux function, log interpolation | |
5525 | YMIN = YMIN1 | |
5526 | YMAX = YMAX1 | |
5527 | YMAX = MIN(YMAX,0.9999999D0) | |
5528 | DELLY = LOG(YMAX/YMIN)/DBLE(Max_tab-1) | |
5529 | TABYL(0) = LOG(YMIN) | |
5530 | FFMAX = 0.D0 | |
5531 | DO 100 I=1,Max_tab | |
5532 | Y = EXP(TABYL(0)+DELLY*DBLE(I-1)) | |
5533 | WG = EE*Y | |
5534 | XI = WG*HIRADI/GAMMA | |
5535 | FF = ALPHA*PHO_GGFLCL(XI)/Y | |
5536 | FFMAX = MAX(FF,FFMAX) | |
5537 | IF(FF.LT.1.D-10*FFMAX) THEN | |
5538 | WRITE(LO,'(/1X,A,2E12.4)') | |
5539 | & 'PHO_GGHIOG: ymax1 changed from/to',YMAX1,Y | |
5540 | YMAX1 = MIN(Y,YMAX1) | |
5541 | GOTO 101 | |
5542 | ENDIF | |
5543 | 100 CONTINUE | |
5544 | 101 CONTINUE | |
5545 | YMIN = YMIN2 | |
5546 | YMAX = YMAX2 | |
5547 | YMAX = MIN(YMAX,0.9999999D0) | |
5548 | DELLY = LOG(YMAX/YMIN)/DBLE(Max_tab-1) | |
5549 | TABYL(0) = LOG(YMIN) | |
5550 | FFMAX = 0.D0 | |
5551 | DO 102 I=1,Max_tab | |
5552 | Y = EXP(TABYL(0)+DELLY*DBLE(I-1)) | |
5553 | WG = EE*Y | |
5554 | XI = WG*HIRADI/GAMMA | |
5555 | FF = ALPHA*PHO_GGFLCL(XI)/Y | |
5556 | FFMAX = MAX(FF,FFMAX) | |
5557 | IF(FF.LT.1.D-10*FFMAX) THEN | |
5558 | WRITE(LO,'(/1X,A,2E12.4)') | |
5559 | & 'PHO_GGHIOG: ymax2 changed from/to',YMAX2,Y | |
5560 | YMAX2 = MIN(Y,YMAX2) | |
5561 | GOTO 103 | |
5562 | ENDIF | |
5563 | 102 CONTINUE | |
5564 | 103 CONTINUE | |
5565 | YMI = (ECMIN/(2.D0*EE))**2/YMAX2 | |
5566 | IF(YMI.GT.YMIN1) THEN | |
5567 | WRITE(LO,'(/1X,A,2E12.4)') | |
5568 | & 'PHO_GGHIOG: ymin1 changed from/to',YMIN1,YMI | |
5569 | YMIN1 = YMI | |
5570 | ENDIF | |
5571 | YMAX1 = MIN(YMAX,YMAX1) | |
5572 | YMI = (ECMIN/(2.D0*EE))**2/YMAX1 | |
5573 | IF(YMI.GT.YMIN2) THEN | |
5574 | WRITE(LO,'(/1X,A,2E12.4)') | |
5575 | & 'PHO_GGHIOG: ymin2 changed from/to',YMIN2,YMI | |
5576 | YMIN2 = YMI | |
5577 | ENDIF | |
5578 | C | |
5579 | YMIN = YMIN1 | |
5580 | YMAX = YMAX1 | |
5581 | DELLY = LOG(YMAX/YMIN)/DBLE(Max_tab-1) | |
5582 | TABCU(0) = 0.D0 | |
5583 | TABYL(0) = LOG(YMIN) | |
5584 | FLUX = 0.D0 | |
5585 | IF(IDEB(30).GE.1) WRITE(LO,'(/1X,A,I5)') | |
5586 | & 'PHO_GGHIOG: table of raw photon flux (side 1)',Max_tab | |
5587 | DO 105 I=1,Max_tab | |
5588 | Y = EXP(TABYL(0)+DELLY*DBLE(I-1)) | |
5589 | WG = EE*Y | |
5590 | XI = WG*HIRADI/GAMMA | |
5591 | FF = ALPHA*PHO_GGFLCL(XI)/Y | |
5592 | FFMAX = MAX(FF,FFMAX) | |
5593 | TABCU(I) = TABCU(I-1)+FF*Y | |
5594 | TABYL(I) = LOG(Y) | |
5595 | FLUX = FLUX+Y*FF | |
5596 | IF(IDEB(30).GE.1) WRITE(LO,'(5X,2E15.4)') Y,FF | |
5597 | 105 CONTINUE | |
5598 | FLUX = FLUX*DELLY | |
5599 | IF(IDEB(30).GE.1) WRITE(LO,'(1X,A,E12.4)') | |
5600 | & 'PHO_GGHIOG: integrated flux (one side):',FLUX | |
5601 | C | |
5602 | C initialization | |
5603 | C photon 1 | |
5604 | EGAM = YMAX*EE | |
5605 | P1(1) = 0.D0 | |
5606 | P1(2) = 0.D0 | |
5607 | P1(3) = EGAM | |
5608 | P1(4) = EGAM | |
5609 | C photon 2 | |
5610 | EGAM = YMAX*EE | |
5611 | P2(1) = 0.D0 | |
5612 | P2(2) = 0.D0 | |
5613 | P2(3) = -EGAM | |
5614 | P2(4) = EGAM | |
5615 | CALL PHO_SETPAR(1,22,0,0.D0) | |
5616 | CALL PHO_SETPAR(2,22,0,0.D0) | |
5617 | CALL PHO_EVENT(-1,P1,P2,SIGMAX,IREJ) | |
5618 | CALL PHO_PHIST(-1,SIGMAX) | |
5619 | CALL PHO_LHIST(-1,SIGMAX) | |
5620 | C | |
5621 | C generation of events | |
5622 | AY1 = 0.D0 | |
5623 | AY2 = 0.D0 | |
5624 | AYS1 = 0.D0 | |
5625 | AYS2 = 0.D0 | |
5626 | YY1MIN = 1.D30 | |
5627 | YY2MIN = 1.D30 | |
5628 | YY1MAX = 0.D0 | |
5629 | YY2MAX = 0.D0 | |
5630 | NITER = NEVENT | |
5631 | ITRY = 0 | |
5632 | ITRW = 0 | |
5633 | DO 200 I=1,NITER | |
5634 | 150 CONTINUE | |
5635 | ITRY = ITRY+1 | |
5636 | 175 CONTINUE | |
5637 | ITRW = ITRW+1 | |
5638 | XI = DT_RNDM(AY1)*TABCU(Max_tab) | |
5639 | DO 110 K=1,Max_tab | |
5640 | IF(TABCU(K).GE.XI) THEN | |
5641 | Y1 = DELLY/(TABCU(K)-TABCU(K-1))*(XI-TABCU(K-1))+TABYL(K-1) | |
5642 | Y1 = EXP(Y1) | |
5643 | GOTO 120 | |
5644 | ENDIF | |
5645 | 110 CONTINUE | |
5646 | Y1 = YMAX1 | |
5647 | 120 CONTINUE | |
5648 | XI = DT_RNDM(AY2)*TABCU(Max_tab) | |
5649 | DO 130 K=1,Max_tab | |
5650 | IF(TABCU(K).GE.XI) THEN | |
5651 | Y2 = DELLY/(TABCU(K)-TABCU(K-1))*(XI-TABCU(K-1))+TABYL(K-1) | |
5652 | Y2 = EXP(Y2) | |
5653 | GOTO 140 | |
5654 | ENDIF | |
5655 | 130 CONTINUE | |
5656 | Y2 = YMAX2 | |
5657 | 140 CONTINUE | |
5658 | C setup kinematics | |
5659 | GYY(1) = Y1 | |
5660 | GQ2(1) = 0.D0 | |
5661 | GYY(2) = Y2 | |
5662 | GQ2(2) = 0.D0 | |
5663 | C incoming electron 1 | |
5664 | PINI(1,1) = 0.D0 | |
5665 | PINI(2,1) = 0.D0 | |
5666 | PINI(3,1) = EE | |
5667 | PINI(4,1) = EE | |
5668 | PINI(5,1) = 0.D0 | |
5669 | C outgoing electron 1 | |
5670 | E1Y = EE*(1.D0-Y1) | |
5671 | PFIN(1,1) = 0.D0 | |
5672 | PFIN(2,1) = 0.D0 | |
5673 | PFIN(3,1) = E1Y | |
5674 | PFIN(4,1) = E1Y | |
5675 | PFIN(5,1) = 0.D0 | |
5676 | C photon 1 | |
5677 | P1(1) = -PFIN(1,1) | |
5678 | P1(2) = -PFIN(2,1) | |
5679 | P1(3) = PINI(3,1)-PFIN(3,1) | |
5680 | P1(4) = PINI(4,1)-PFIN(4,1) | |
5681 | C incoming electron 2 | |
5682 | PINI(1,2) = 0.D0 | |
5683 | PINI(2,2) = 0.D0 | |
5684 | PINI(3,2) = -EE | |
5685 | PINI(4,2) = EE | |
5686 | PINI(5,2) = 0.D0 | |
5687 | C outgoing electron 2 | |
5688 | E1Y = EE*(1.D0-Y2) | |
5689 | PFIN(1,2) = 0.D0 | |
5690 | PFIN(2,2) = 0.D0 | |
5691 | PFIN(3,2) = -E1Y | |
5692 | PFIN(4,2) = E1Y | |
5693 | PFIN(5,2) = 0.D0 | |
5694 | C photon 2 | |
5695 | P2(1) = -PFIN(1,2) | |
5696 | P2(2) = -PFIN(2,2) | |
5697 | P2(3) = PINI(3,2)-PFIN(3,2) | |
5698 | P2(4) = PINI(4,2)-PFIN(4,2) | |
5699 | C ECMS cut | |
5700 | GGECM = (P1(4)+P2(4))**2-(P1(3)+P2(3))**2 | |
5701 | IF(GGECM.LT.0.1D0) GOTO 175 | |
5702 | GGECM = SQRT(GGECM) | |
5703 | IF((GGECM.LT.ECMIN).OR.(GGECM.GT.ECMAX)) GOTO 175 | |
5704 | PGAM(1,1) = P1(1) | |
5705 | PGAM(2,1) = P1(2) | |
5706 | PGAM(3,1) = P1(3) | |
5707 | PGAM(4,1) = P1(4) | |
5708 | PGAM(5,1) = 0.D0 | |
5709 | PGAM(1,2) = P2(1) | |
5710 | PGAM(2,2) = P2(2) | |
5711 | PGAM(3,2) = P2(3) | |
5712 | PGAM(4,2) = P2(4) | |
5713 | PGAM(5,2) = 0.D0 | |
5714 | C impact parameter constraints | |
5715 | XI1 = P1(4)*HIRADI/GAMMA | |
5716 | XI2 = P2(4)*HIRADI/GAMMA | |
5717 | FLX = PHO_GGFLCL(XI1)*PHO_GGFLCL(XI2) | |
5718 | FCORR = PHO_GGFLCR(HIRADI) | |
5719 | WGX = (FLX-FCORR)/FLX | |
5720 | IF(DT_RNDM(Y2).GT.WGX) GOTO 175 | |
5721 | C photon helicities | |
5722 | IGHEL(1) = 1 | |
5723 | IGHEL(2) = 1 | |
5724 | C cut given by user | |
5725 | CALL PHO_PRESEL(5,IREJ) | |
5726 | IF(IREJ.NE.0) GOTO 175 | |
5727 | C event generation | |
5728 | CALL PHO_EVENT(1,P1,P2,SIGCUR,IREJ) | |
5729 | IF(IREJ.NE.0) GOTO 150 | |
5730 | C statistics | |
5731 | AY1 = AY1+Y1 | |
5732 | AYS1 = AYS1+Y1*Y1 | |
5733 | AY2 = AY2+Y2 | |
5734 | AYS2 = AYS2+Y2*Y2 | |
5735 | YY1MIN = MIN(YY1MIN,Y1) | |
5736 | YY2MIN = MIN(YY2MIN,Y2) | |
5737 | YY1MAX = MAX(YY1MAX,Y1) | |
5738 | YY2MAX = MAX(YY2MAX,Y2) | |
5739 | C histograms | |
5740 | CALL PHO_PHIST(1,HSWGHT(0)) | |
5741 | CALL PHO_LHIST(1,HSWGHT(0)) | |
5742 | 200 CONTINUE | |
5743 | C | |
5744 | WGY = FLUX**2*DBLE(ITRY)/DBLE(ITRW) | |
5745 | AY1 = AY1/DBLE(NITER) | |
5746 | AYS1 = AYS1/DBLE(NITER) | |
5747 | DAY1 = SQRT((AYS1-AY1**2)/DBLE(NITER)) | |
5748 | AY2 = AY2/DBLE(NITER) | |
5749 | AYS2 = AYS2/DBLE(NITER) | |
5750 | DAY2 = SQRT((AYS2-AY2**2)/DBLE(NITER)) | |
5751 | WEIGHT = WGY*SIGMAX*DBLE(NITER)/DBLE(ITRY) | |
5752 | C output of statistics, histograms | |
5753 | WRITE(LO,'(//1X,A,/1X,A,1PE12.3,A,/1X,A)') | |
5754 | &'=========================================================', | |
5755 | &' ***** simulated cross section: ',WEIGHT,' mb *****', | |
5756 | &'=========================================================' | |
5757 | WRITE(LO,'(//1X,A,3I12)') | |
5758 | & 'PHO_GGHIOG:SUMMARY:NITER,ITRY,ITRW',NITER,ITRY,ITRW | |
5759 | WRITE(LO,'(1X,A,1P2E12.4)') 'EFFECTIVE WEIGHT (FLUX,TOTAL)', | |
5760 | & WGY,WEIGHT | |
5761 | WRITE(LO,'(1X,A,1P2E12.4)') 'AVERAGE Y1,DY1 ', | |
5762 | & AY1,DAY1 | |
5763 | WRITE(LO,'(1X,A,1P2E12.4)') 'AVERAGE Y2,DY2 ', | |
5764 | & AY2,DAY2 | |
5765 | WRITE(LO,'(1X,A,1P2E12.4)') 'SAMPLED Y RANGE PHOTON 1 ', | |
5766 | & YY1MIN,YY1MAX | |
5767 | WRITE(LO,'(1X,A,1P2E12.4)') 'SAMPLED Y RANGE PHOTON 2 ', | |
5768 | & YY2MIN,YY2MAX | |
5769 | ||
5770 | C | |
5771 | CALL PHO_EVENT(-2,P1,P2,WEIGHT,IREJ) | |
5772 | IF(NITER.GT.1) THEN | |
5773 | CALL PHO_PHIST(-2,WEIGHT) | |
5774 | CALL PHO_LHIST(-2,WEIGHT) | |
5775 | ELSE | |
5776 | WRITE(LO,'(1X,A,I4)') 'PHO_GGHIOG:NO OUTPUT OF HISTOGRAMS',NITER | |
5777 | ENDIF | |
5778 | ||
5779 | END | |
5780 | ||
5781 | *$ CREATE PHO_GGFLCL.FOR | |
5782 | *COPY PHO_GGFLCL | |
5783 | CDECK ID>, PHO_GGFLCL | |
5784 | DOUBLE PRECISION FUNCTION PHO_GGFLCL(XI) | |
5785 | C********************************************************************* | |
5786 | C | |
5787 | C semi-classical photon flux (geometrical model) | |
5788 | C | |
5789 | C********************************************************************* | |
5790 | IMPLICIT DOUBLE PRECISION (A-H,O-Z) | |
5791 | SAVE | |
5792 | ||
5793 | PHO_GGFLCL = 2.D0/3.1415927D0*(XI*PHO_BESSK0(XI)*PHO_BESSK1(XI) | |
5794 | & -XI**2/2.D0*(PHO_BESSK1(XI)**2-PHO_BESSK0(XI)**2)) | |
5795 | ||
5796 | END | |
5797 | ||
5798 | *$ CREATE PHO_GGFLCR.FOR | |
5799 | *COPY PHO_GGFLCR | |
5800 | CDECK ID>, PHO_GGFLCR | |
5801 | DOUBLE PRECISION FUNCTION PHO_GGFLCR(XI) | |
5802 | C********************************************************************* | |
5803 | C | |
5804 | C semi-classical photon flux correction due to | |
5805 | C overlap in impact parameter space (geometrical model) | |
5806 | C | |
5807 | C********************************************************************* | |
5808 | IMPLICIT DOUBLE PRECISION (A-H,O-Z) | |
5809 | SAVE | |
5810 | ||
5811 | PARAMETER (PI = 3.14159265359D0, ACCUR = 1D-2) | |
5812 | ||
5813 | C input/output channels | |
5814 | INTEGER LI,LO | |
5815 | COMMON /POINOU/ LI,LO | |
5816 | C gamma-lepton or gamma-hadron vertex information | |
5817 | INTEGER IGHEL,IDPSRC,IDBSRC | |
5818 | DOUBLE PRECISION PINI,PFIN,PGAM,GYY,GQ2,GGECM,GAIMP,PFTHE,PFPHI, | |
5819 | & RADSRC,AMSRC,GAMSRC | |
5820 | COMMON /POFSRC/ PINI(5,2),PFIN(5,2),PGAM(5,2),IGHEL(2), | |
5821 | & GYY(2),GQ2(2),GGECM,GAIMP(2),PFTHE(2),PFPHI(2), | |
5822 | & IDPSRC(2),IDBSRC(2),RADSRC(2),AMSRC(2),GAMSRC(2) | |
5823 | ||
5824 | DIMENSION XGAUSS(126),WGAUSS(126) | |
5825 | ||
5826 | DATA XGAUSS(1)/ .57735026918962576D0/ | |
5827 | DATA XGAUSS(2)/-.57735026918962576D0/ | |
5828 | DATA WGAUSS(1)/ 1.00000000000000000D0/ | |
5829 | DATA WGAUSS(2)/ 1.00000000000000000D0/ | |
5830 | ||
5831 | DATA XGAUSS(3)/ .33998104358485627D0/ | |
5832 | DATA XGAUSS(4)/ .86113631159405258D0/ | |
5833 | DATA XGAUSS(5)/-.33998104358485627D0/ | |
5834 | DATA XGAUSS(6)/-.86113631159405258D0/ | |
5835 | DATA WGAUSS(3)/ .65214515486254613D0/ | |
5836 | DATA WGAUSS(4)/ .34785484513745385D0/ | |
5837 | DATA WGAUSS(5)/ .65214515486254613D0/ | |
5838 | DATA WGAUSS(6)/ .34785484513745385D0/ | |
5839 | ||
5840 | DATA XGAUSS(7)/ .18343464249564981D0/ | |
5841 | DATA XGAUSS(8)/ .52553240991632899D0/ | |
5842 | DATA XGAUSS(9)/ .79666647741362674D0/ | |
5843 | DATA XGAUSS(10)/ .96028985649753623D0/ | |
5844 | DATA XGAUSS(11)/-.18343464249564981D0/ | |
5845 | DATA XGAUSS(12)/-.52553240991632899D0/ | |
5846 | DATA XGAUSS(13)/-.79666647741362674D0/ | |
5847 | DATA XGAUSS(14)/-.96028985649753623D0/ | |
5848 | DATA WGAUSS(7)/ .36268378337836198D0/ | |
5849 | DATA WGAUSS(8)/ .31370664587788727D0/ | |
5850 | DATA WGAUSS(9)/ .22238103445337448D0/ | |
5851 | DATA WGAUSS(10)/ .10122853629037627D0/ | |
5852 | DATA WGAUSS(11)/ .36268378337836198D0/ | |
5853 | DATA WGAUSS(12)/ .31370664587788727D0/ | |
5854 | DATA WGAUSS(13)/ .22238103445337448D0/ | |
5855 | DATA WGAUSS(14)/ .10122853629037627D0/ | |
5856 | ||
5857 | DATA XGAUSS(15)/ .0950125098376374402D0/ | |
5858 | DATA XGAUSS(16)/ .281603550779258913D0/ | |
5859 | DATA XGAUSS(17)/ .458016777657227386D0/ | |
5860 | DATA XGAUSS(18)/ .617876244402643748D0/ | |
5861 | DATA XGAUSS(19)/ .755404408355003034D0/ | |
5862 | DATA XGAUSS(20)/ .865631202387831744D0/ | |
5863 | DATA XGAUSS(21)/ .944575023073232576D0/ | |
5864 | DATA XGAUSS(22)/ .989400934991649933D0/ | |
5865 | DATA XGAUSS(23)/-.0950125098376374402D0/ | |
5866 | DATA XGAUSS(24)/-.281603550779258913D0/ | |
5867 | DATA XGAUSS(25)/-.458016777657227386D0/ | |
5868 | DATA XGAUSS(26)/-.617876244402643748D0/ | |
5869 | DATA XGAUSS(27)/-.755404408355003034D0/ | |
5870 | DATA XGAUSS(28)/-.865631202387831744D0/ | |
5871 | DATA XGAUSS(29)/-.944575023073232576D0/ | |
5872 | DATA XGAUSS(30)/-.989400934991649933D0/ | |
5873 | DATA WGAUSS(15)/ .189450610455068496D0/ | |
5874 | DATA WGAUSS(16)/ .182603415044923589D0/ | |
5875 | DATA WGAUSS(17)/ .169156519395002538D0/ | |
5876 | DATA WGAUSS(18)/ .149595988816576732D0/ | |
5877 | DATA WGAUSS(19)/ .124628971255533872D0/ | |
5878 | DATA WGAUSS(20)/ .0951585116824927848D0/ | |
5879 | DATA WGAUSS(21)/ .0622535239386478929D0/ | |
5880 | DATA WGAUSS(22)/ .0271524594117540949D0/ | |
5881 | DATA WGAUSS(23)/ .189450610455068496D0/ | |
5882 | DATA WGAUSS(24)/ .182603415044923589D0/ | |
5883 | DATA WGAUSS(25)/ .169156519395002538D0/ | |
5884 | DATA WGAUSS(26)/ .149595988816576732D0/ | |
5885 | DATA WGAUSS(27)/ .124628971255533872D0/ | |
5886 | DATA WGAUSS(28)/ .0951585116824927848D0/ | |
5887 | DATA WGAUSS(29)/ .0622535239386478929D0/ | |
5888 | DATA WGAUSS(30)/ .0271524594117540949D0/ | |
5889 | ||
5890 | DATA XGAUSS(31)/ .0483076656877383162D0/ | |
5891 | DATA XGAUSS(32)/ .144471961582796493D0/ | |
5892 | DATA XGAUSS(33)/ .239287362252137075D0/ | |
5893 | DATA XGAUSS(34)/ .331868602282127650D0/ | |
5894 | DATA XGAUSS(35)/ .421351276130635345D0/ | |
5895 | DATA XGAUSS(36)/ .506899908932229390D0/ | |
5896 | DATA XGAUSS(37)/ .587715757240762329D0/ | |
5897 | DATA XGAUSS(38)/ .663044266930215201D0/ | |
5898 | DATA XGAUSS(39)/ .732182118740289680D0/ | |
5899 | DATA XGAUSS(40)/ .794483795967942407D0/ | |
5900 | DATA XGAUSS(41)/ .849367613732569970D0/ | |
5901 | DATA XGAUSS(42)/ .896321155766052124D0/ | |
5902 | DATA XGAUSS(43)/ .934906075937739689D0/ | |
5903 | DATA XGAUSS(44)/ .964762255587506430D0/ | |
5904 | DATA XGAUSS(45)/ .985611511545268335D0/ | |
5905 | DATA XGAUSS(46)/ .997263861849481564D0/ | |
5906 | DATA XGAUSS(47)/-.0483076656877383162D0/ | |
5907 | DATA XGAUSS(48)/-.144471961582796493D0/ | |
5908 | DATA XGAUSS(49)/-.239287362252137075D0/ | |
5909 | DATA XGAUSS(50)/-.331868602282127650D0/ | |
5910 | DATA XGAUSS(51)/-.421351276130635345D0/ | |
5911 | DATA XGAUSS(52)/-.506899908932229390D0/ | |
5912 | DATA XGAUSS(53)/-.587715757240762329D0/ | |
5913 | DATA XGAUSS(54)/-.663044266930215201D0/ | |
5914 | DATA XGAUSS(55)/-.732182118740289680D0/ | |
5915 | DATA XGAUSS(56)/-.794483795967942407D0/ | |
5916 | DATA XGAUSS(57)/-.849367613732569970D0/ | |
5917 | DATA XGAUSS(58)/-.896321155766052124D0/ | |
5918 | DATA XGAUSS(59)/-.934906075937739689D0/ | |
5919 | DATA XGAUSS(60)/-.964762255587506430D0/ | |
5920 | DATA XGAUSS(61)/-.985611511545268335D0/ | |
5921 | DATA XGAUSS(62)/-.997263861849481564D0/ | |
5922 | DATA WGAUSS(31)/ .0965400885147278006D0/ | |
5923 | DATA WGAUSS(32)/ .0956387200792748594D0/ | |
5924 | DATA WGAUSS(33)/ .0938443990808045654D0/ | |
5925 | DATA WGAUSS(34)/ .0911738786957638847D0/ | |
5926 | DATA WGAUSS(35)/ .0876520930044038111D0/ | |
5927 | DATA WGAUSS(36)/ .0833119242269467552D0/ | |
5928 | DATA WGAUSS(37)/ .0781938957870703065D0/ | |
5929 | DATA WGAUSS(38)/ .0723457941088485062D0/ | |
5930 | DATA WGAUSS(39)/ .0658222227763618468D0/ | |
5931 | DATA WGAUSS(40)/ .0586840934785355471D0/ | |
5932 | DATA WGAUSS(41)/ .0509980592623761762D0/ | |
5933 | DATA WGAUSS(42)/ .0428358980222266807D0/ | |
5934 | DATA WGAUSS(43)/ .0342738629130214331D0/ | |
5935 | DATA WGAUSS(44)/ .0253920653092620595D0/ | |
5936 | DATA WGAUSS(45)/ .0162743947309056706D0/ | |
5937 | DATA WGAUSS(46)/ .00701861000947009660D0/ | |
5938 | DATA WGAUSS(47)/ .0965400885147278006D0/ | |
5939 | DATA WGAUSS(48)/ .0956387200792748594D0/ | |
5940 | DATA WGAUSS(49)/ .0938443990808045654D0/ | |
5941 | DATA WGAUSS(50)/ .0911738786957638847D0/ | |
5942 | DATA WGAUSS(51)/ .0876520930044038111D0/ | |
5943 | DATA WGAUSS(52)/ .0833119242269467552D0/ | |
5944 | DATA WGAUSS(53)/ .0781938957870703065D0/ | |
5945 | DATA WGAUSS(54)/ .0723457941088485062D0/ | |
5946 | DATA WGAUSS(55)/ .0658222227763618468D0/ | |
5947 | DATA WGAUSS(56)/ .0586840934785355471D0/ | |
5948 | DATA WGAUSS(57)/ .0509980592623761762D0/ | |
5949 | DATA WGAUSS(58)/ .0428358980222266807D0/ | |
5950 | DATA WGAUSS(59)/ .0342738629130214331D0/ | |
5951 | DATA WGAUSS(60)/ .0253920653092620595D0/ | |
5952 | DATA WGAUSS(61)/ .0162743947309056706D0/ | |
5953 | DATA WGAUSS(62)/ .00701861000947009660D0/ | |
5954 | ||
5955 | DATA XGAUSS(63)/ .02435029266342443250D0/ | |
5956 | DATA XGAUSS(64)/ .0729931217877990394D0/ | |
5957 | DATA XGAUSS(65)/ .121462819296120554D0/ | |
5958 | DATA XGAUSS(66)/ .169644420423992818D0/ | |
5959 | DATA XGAUSS(67)/ .217423643740007084D0/ | |
5960 | DATA XGAUSS(68)/ .264687162208767416D0/ | |
5961 | DATA XGAUSS(69)/ .311322871990210956D0/ | |
5962 | DATA XGAUSS(70)/ .357220158337668116D0/ | |
5963 | DATA XGAUSS(71)/ .402270157963991604D0/ | |
5964 | DATA XGAUSS(72)/ .446366017253464088D0/ | |
5965 | DATA XGAUSS(73)/ .489403145707052957D0/ | |
5966 | DATA XGAUSS(74)/ .531279464019894546D0/ | |
5967 | DATA XGAUSS(75)/ .571895646202634034D0/ | |
5968 | DATA XGAUSS(76)/ .611155355172393250D0/ | |
5969 | DATA XGAUSS(77)/ .648965471254657340D0/ | |
5970 | DATA XGAUSS(78)/ .685236313054233243D0/ | |
5971 | DATA XGAUSS(79)/ .719881850171610827D0/ | |
5972 | DATA XGAUSS(80)/ .752819907260531897D0/ | |
5973 | DATA XGAUSS(81)/ .783972358943341408D0/ | |
5974 | DATA XGAUSS(82)/ .813265315122797560D0/ | |
5975 | DATA XGAUSS(83)/ .840629296252580363D0/ | |
5976 | DATA XGAUSS(84)/ .865999398154092820D0/ | |
5977 | DATA XGAUSS(85)/ .889315445995114106D0/ | |
5978 | DATA XGAUSS(86)/ .910522137078502806D0/ | |
5979 | DATA XGAUSS(87)/ .929569172131939576D0/ | |
5980 | DATA XGAUSS(88)/ .946411374858402816D0/ | |
5981 | DATA XGAUSS(89)/ .961008799652053719D0/ | |
5982 | DATA XGAUSS(90)/ .973326827789910964D0/ | |
5983 | DATA XGAUSS(91)/ .983336253884625957D0/ | |
5984 | DATA XGAUSS(92)/ .991013371476744321D0/ | |
5985 | DATA XGAUSS(93)/ .996340116771955279D0/ | |
5986 | DATA XGAUSS(94)/ .999305041735772139D0/ | |
5987 | DATA XGAUSS(95)/-.02435029266342443250D0/ | |
5988 | DATA XGAUSS(96)/-.0729931217877990394D0/ | |
5989 | DATA XGAUSS(97)/-.121462819296120554D0/ | |
5990 | DATA XGAUSS(98)/-.169644420423992818D0/ | |
5991 | DATA XGAUSS(99)/-.217423643740007084D0/ | |
5992 | DATA XGAUSS(100)/-.264687162208767416D0/ | |
5993 | DATA XGAUSS(101)/-.311322871990210956D0/ | |
5994 | DATA XGAUSS(102)/-.357220158337668116D0/ | |
5995 | DATA XGAUSS(103)/-.402270157963991604D0/ | |
5996 | DATA XGAUSS(104)/-.446366017253464088D0/ | |
5997 | DATA XGAUSS(105)/-.489403145707052957D0/ | |
5998 | DATA XGAUSS(106)/-.531279464019894546D0/ | |
5999 | DATA XGAUSS(107)/-.571895646202634034D0/ | |
6000 | DATA XGAUSS(108)/-.611155355172393250D0/ | |
6001 | DATA XGAUSS(109)/-.648965471254657340D0/ | |
6002 | DATA XGAUSS(110)/-.685236313054233243D0/ | |
6003 | DATA XGAUSS(111)/-.719881850171610827D0/ | |
6004 | DATA XGAUSS(112)/-.752819907260531897D0/ | |
6005 | DATA XGAUSS(113)/-.783972358943341408D0/ | |
6006 | DATA XGAUSS(114)/-.813265315122797560D0/ | |
6007 | DATA XGAUSS(115)/-.840629296252580363D0/ | |
6008 | DATA XGAUSS(116)/-.865999398154092820D0/ | |
6009 | DATA XGAUSS(117)/-.889315445995114106D0/ | |
6010 | DATA XGAUSS(118)/-.910522137078502806D0/ | |
6011 | DATA XGAUSS(119)/-.929569172131939576D0/ | |
6012 | DATA XGAUSS(120)/-.946411374858402816D0/ | |
6013 | DATA XGAUSS(121)/-.961008799652053719D0/ | |
6014 | DATA XGAUSS(122)/-.973326827789910964D0/ | |
6015 | DATA XGAUSS(123)/-.983336253884625957D0/ | |
6016 | DATA XGAUSS(124)/-.991013371476744321D0/ | |
6017 | DATA XGAUSS(125)/-.996340116771955279D0/ | |
6018 | DATA XGAUSS(126)/-.999305041735772139D0/ | |
6019 | DATA WGAUSS(63)/ .0486909570091397204D0/ | |
6020 | DATA WGAUSS(64)/ .0485754674415034269D0/ | |
6021 | DATA WGAUSS(65)/ .0483447622348029572D0/ | |
6022 | DATA WGAUSS(66)/ .0479993885964583077D0/ | |
6023 | DATA WGAUSS(67)/ .0475401657148303087D0/ | |
6024 | DATA WGAUSS(68)/ .0469681828162100173D0/ | |
6025 | DATA WGAUSS(69)/ .0462847965813144172D0/ | |
6026 | DATA WGAUSS(70)/ .0454916279274181445D0/ | |
6027 | DATA WGAUSS(71)/ .0445905581637565631D0/ | |
6028 | DATA WGAUSS(72)/ .0435837245293234534D0/ | |
6029 | DATA WGAUSS(73)/ .0424735151236535890D0/ | |
6030 | DATA WGAUSS(74)/ .0412625632426235286D0/ | |
6031 | DATA WGAUSS(75)/ .0399537411327203414D0/ | |
6032 | DATA WGAUSS(76)/ .0385501531786156291D0/ | |
6033 | DATA WGAUSS(77)/ .0370551285402400460D0/ | |
6034 | DATA WGAUSS(78)/ .0354722132568823838D0/ | |
6035 | DATA WGAUSS(79)/ .0338051618371416094D0/ | |
6036 | DATA WGAUSS(80)/ .0320579283548515535D0/ | |
6037 | DATA WGAUSS(81)/ .0302346570724024789D0/ | |
6038 | DATA WGAUSS(82)/ .0283396726142594832D0/ | |
6039 | DATA WGAUSS(83)/ .0263774697150546587D0/ | |
6040 | DATA WGAUSS(84)/ .0243527025687108733D0/ | |
6041 | DATA WGAUSS(85)/ .0222701738083832542D0/ | |
6042 | DATA WGAUSS(86)/ .0201348231535302094D0/ | |
6043 | DATA WGAUSS(87)/ .0179517157756973431D0/ | |
6044 | DATA WGAUSS(88)/ .0157260304760247193D0/ | |
6045 | DATA WGAUSS(89)/ .0134630478967186426D0/ | |
6046 | DATA WGAUSS(90)/ .0111681394601311288D0/ | |
6047 | DATA WGAUSS(91)/ .00884675982636394772D0/ | |
6048 | DATA WGAUSS(92)/ .00650445796897836286D0/ | |
6049 | DATA WGAUSS(93)/ .00414703326056246764D0/ | |
6050 | DATA WGAUSS(94)/ .00178328072169643295D0/ | |
6051 | DATA WGAUSS(95)/ .0486909570091397204D0/ | |
6052 | DATA WGAUSS(96)/ .0485754674415034269D0/ | |
6053 | DATA WGAUSS(97)/ .0483447622348029572D0/ | |
6054 | DATA WGAUSS(98)/ .0479993885964583077D0/ | |
6055 | DATA WGAUSS(99)/ .0475401657148303087D0/ | |
6056 | DATA WGAUSS(100)/ .0469681828162100173D0/ | |
6057 | DATA WGAUSS(101)/ .0462847965813144172D0/ | |
6058 | DATA WGAUSS(102)/ .0454916279274181445D0/ | |
6059 | DATA WGAUSS(103)/ .0445905581637565631D0/ | |
6060 | DATA WGAUSS(104)/ .0435837245293234534D0/ | |
6061 | DATA WGAUSS(105)/ .0424735151236535890D0/ | |
6062 | DATA WGAUSS(106)/ .0412625632426235286D0/ | |
6063 | DATA WGAUSS(107)/ .0399537411327203414D0/ | |
6064 | DATA WGAUSS(108)/ .0385501531786156291D0/ | |
6065 | DATA WGAUSS(109)/ .0370551285402400460D0/ | |
6066 | DATA WGAUSS(110)/ .0354722132568823838D0/ | |
6067 | DATA WGAUSS(111)/ .0338051618371416094D0/ | |
6068 | DATA WGAUSS(112)/ .0320579283548515535D0/ | |
6069 | DATA WGAUSS(113)/ .0302346570724024789D0/ | |
6070 | DATA WGAUSS(114)/ .0283396726142594832D0/ | |
6071 | DATA WGAUSS(115)/ .0263774697150546587D0/ | |
6072 | DATA WGAUSS(116)/ .0243527025687108733D0/ | |
6073 | DATA WGAUSS(117)/ .0222701738083832542D0/ | |
6074 | DATA WGAUSS(118)/ .0201348231535302094D0/ | |
6075 | DATA WGAUSS(119)/ .0179517157756973431D0/ | |
6076 | DATA WGAUSS(120)/ .0157260304760247193D0/ | |
6077 | DATA WGAUSS(121)/ .0134630478967186426D0/ | |
6078 | DATA WGAUSS(122)/ .0111681394601311288D0/ | |
6079 | DATA WGAUSS(123)/ .00884675982636394772D0/ | |
6080 | DATA WGAUSS(124)/ .00650445796897836286D0/ | |
6081 | DATA WGAUSS(125)/ .00414703326056246764D0/ | |
6082 | DATA WGAUSS(126)/ .00178328072169643295D0/ | |
6083 | ||
6084 | C integrate first over b1 | |
6085 | C | |
6086 | C Loop incrementing the boundary | |
6087 | C | |
6088 | tmin = 0.D0 | |
6089 | tmax = 0.25D0 | |
6090 | Sum = 0.D0 | |
6091 | ||
6092 | 50 CONTINUE | |
6093 | ||
6094 | C | |
6095 | C Loop for the Gauss integration | |
6096 | C | |
6097 | XINT=0.D0 | |
6098 | DO 100 N=1,6 | |
6099 | XINT2 = XINT | |
6100 | XINT=0.D0 | |
6101 | DO 200 I=2**N-1,2**(N+1)-2 | |
6102 | t = (tmax-tmin)/2.D0*XGAUSS(I)+(tmax+tmin)/2.D0 | |
6103 | b1 = RADSRC(1) * EXP (t) | |
6104 | XINT=XINT+WGAUSS(I) * PHO_GGFAUX(b1) * b1**2 | |
6105 | 200 CONTINUE | |
6106 | XINT = (tmax-tmin)/2.D0*XINT | |
6107 | IF (ABS ((XINT2-XINT)/XINT) .LT. ACCUR) GOTO 300 | |
6108 | 100 CONTINUE | |
6109 | WRITE(LO,*) ' (b1) GAUSS MAY BE INACCURATE' | |
6110 | 300 CONTINUE | |
6111 | ||
6112 | Sum = Sum + XINT | |
6113 | IF (ABS (XINT2/Sum) .GT. ACCUR) THEN | |
6114 | tmin = tmax | |
6115 | tmax = tmax + 0.5D0 | |
6116 | GOTO 50 | |
6117 | ENDIF | |
6118 | ||
6119 | PHO_GGFLCR = 4.D0*Pi * Sum | |
6120 | ||
6121 | END | |
6122 | ||
6123 | *$ CREATE PHO_GGFAUX.FOR | |
6124 | *COPY PHO_GGFAUX | |
6125 | CDECK ID>, PHO_GGFAUX | |
6126 | DOUBLE PRECISION FUNCTION PHO_GGFAUX(b1) | |
6127 | C********************************************************************* | |
6128 | C | |
6129 | C auxiliary function for integration over b2, | |
6130 | C semi-classical photon flux correction due to | |
6131 | C overlap in impact parameter space (geometrical model) | |
6132 | C | |
6133 | C********************************************************************* | |
6134 | IMPLICIT DOUBLE PRECISION (A-H,O-Z) | |
6135 | SAVE | |
6136 | ||
6137 | PARAMETER (PI = 3.14159265359D0, ACCUR = 1D-2) | |
6138 | ||
6139 | C input/output channels | |
6140 | INTEGER LI,LO | |
6141 | COMMON /POINOU/ LI,LO | |
6142 | C gamma-lepton or gamma-hadron vertex information | |
6143 | INTEGER IGHEL,IDPSRC,IDBSRC | |
6144 | DOUBLE PRECISION PINI,PFIN,PGAM,GYY,GQ2,GGECM,GAIMP,PFTHE,PFPHI, | |
6145 | & RADSRC,AMSRC,GAMSRC | |
6146 | COMMON /POFSRC/ PINI(5,2),PFIN(5,2),PGAM(5,2),IGHEL(2), | |
6147 | & GYY(2),GQ2(2),GGECM,GAIMP(2),PFTHE(2),PFPHI(2), | |
6148 | & IDPSRC(2),IDBSRC(2),RADSRC(2),AMSRC(2),GAMSRC(2) | |
6149 | ||
6150 | DIMENSION XGAUSS(126),WGAUSS(126) | |
6151 | ||
6152 | DATA XGAUSS(1)/ .57735026918962576D0/ | |
6153 | DATA XGAUSS(2)/-.57735026918962576D0/ | |
6154 | DATA WGAUSS(1)/ 1.00000000000000000D0/ | |
6155 | DATA WGAUSS(2)/ 1.00000000000000000D0/ | |
6156 | ||
6157 | DATA XGAUSS(3)/ .33998104358485627D0/ | |
6158 | DATA XGAUSS(4)/ .86113631159405258D0/ | |
6159 | DATA XGAUSS(5)/-.33998104358485627D0/ | |
6160 | DATA XGAUSS(6)/-.86113631159405258D0/ | |
6161 | DATA WGAUSS(3)/ .65214515486254613D0/ | |
6162 | DATA WGAUSS(4)/ .34785484513745385D0/ | |
6163 | DATA WGAUSS(5)/ .65214515486254613D0/ | |
6164 | DATA WGAUSS(6)/ .34785484513745385D0/ | |
6165 | ||
6166 | DATA XGAUSS(7)/ .18343464249564981D0/ | |
6167 | DATA XGAUSS(8)/ .52553240991632899D0/ | |
6168 | DATA XGAUSS(9)/ .79666647741362674D0/ | |
6169 | DATA XGAUSS(10)/ .96028985649753623D0/ | |
6170 | DATA XGAUSS(11)/-.18343464249564981D0/ | |
6171 | DATA XGAUSS(12)/-.52553240991632899D0/ | |
6172 | DATA XGAUSS(13)/-.79666647741362674D0/ | |
6173 | DATA XGAUSS(14)/-.96028985649753623D0/ | |
6174 | DATA WGAUSS(7)/ .36268378337836198D0/ | |
6175 | DATA WGAUSS(8)/ .31370664587788727D0/ | |
6176 | DATA WGAUSS(9)/ .22238103445337448D0/ | |
6177 | DATA WGAUSS(10)/ .10122853629037627D0/ | |
6178 | DATA WGAUSS(11)/ .36268378337836198D0/ | |
6179 | DATA WGAUSS(12)/ .31370664587788727D0/ | |
6180 | DATA WGAUSS(13)/ .22238103445337448D0/ | |
6181 | DATA WGAUSS(14)/ .10122853629037627D0/ | |
6182 | ||
6183 | DATA XGAUSS(15)/ .0950125098376374402D0/ | |
6184 | DATA XGAUSS(16)/ .281603550779258913D0/ | |
6185 | DATA XGAUSS(17)/ .458016777657227386D0/ | |
6186 | DATA XGAUSS(18)/ .617876244402643748D0/ | |
6187 | DATA XGAUSS(19)/ .755404408355003034D0/ | |
6188 | DATA XGAUSS(20)/ .865631202387831744D0/ | |
6189 | DATA XGAUSS(21)/ .944575023073232576D0/ | |
6190 | DATA XGAUSS(22)/ .989400934991649933D0/ | |
6191 | DATA XGAUSS(23)/-.0950125098376374402D0/ | |
6192 | DATA XGAUSS(24)/-.281603550779258913D0/ | |
6193 | DATA XGAUSS(25)/-.458016777657227386D0/ | |
6194 | DATA XGAUSS(26)/-.617876244402643748D0/ | |
6195 | DATA XGAUSS(27)/-.755404408355003034D0/ | |
6196 | DATA XGAUSS(28)/-.865631202387831744D0/ | |
6197 | DATA XGAUSS(29)/-.944575023073232576D0/ | |
6198 | DATA XGAUSS(30)/-.989400934991649933D0/ | |
6199 | DATA WGAUSS(15)/ .189450610455068496D0/ | |
6200 | DATA WGAUSS(16)/ .182603415044923589D0/ | |
6201 | DATA WGAUSS(17)/ .169156519395002538D0/ | |
6202 | DATA WGAUSS(18)/ .149595988816576732D0/ | |
6203 | DATA WGAUSS(19)/ .124628971255533872D0/ | |
6204 | DATA WGAUSS(20)/ .0951585116824927848D0/ | |
6205 | DATA WGAUSS(21)/ .0622535239386478929D0/ | |
6206 | DATA WGAUSS(22)/ .0271524594117540949D0/ | |
6207 | DATA WGAUSS(23)/ .189450610455068496D0/ | |
6208 | DATA WGAUSS(24)/ .182603415044923589D0/ | |
6209 | DATA WGAUSS(25)/ .169156519395002538D0/ | |
6210 | DATA WGAUSS(26)/ .149595988816576732D0/ | |
6211 | DATA WGAUSS(27)/ .124628971255533872D0/ | |
6212 | DATA WGAUSS(28)/ .0951585116824927848D0/ | |
6213 | DATA WGAUSS(29)/ .0622535239386478929D0/ | |
6214 | DATA WGAUSS(30)/ .0271524594117540949D0/ | |
6215 | ||
6216 | DATA XGAUSS(31)/ .0483076656877383162D0/ | |
6217 | DATA XGAUSS(32)/ .144471961582796493D0/ | |
6218 | DATA XGAUSS(33)/ .239287362252137075D0/ | |
6219 | DATA XGAUSS(34)/ .331868602282127650D0/ | |
6220 | DATA XGAUSS(35)/ .421351276130635345D0/ | |
6221 | DATA XGAUSS(36)/ .506899908932229390D0/ | |
6222 | DATA XGAUSS(37)/ .587715757240762329D0/ | |
6223 | DATA XGAUSS(38)/ .663044266930215201D0/ | |
6224 | DATA XGAUSS(39)/ .732182118740289680D0/ | |
6225 | DATA XGAUSS(40)/ .794483795967942407D0/ | |
6226 | DATA XGAUSS(41)/ .849367613732569970D0/ | |
6227 | DATA XGAUSS(42)/ .896321155766052124D0/ | |
6228 | DATA XGAUSS(43)/ .934906075937739689D0/ | |
6229 | DATA XGAUSS(44)/ .964762255587506430D0/ | |
6230 | DATA XGAUSS(45)/ .985611511545268335D0/ | |
6231 | DATA XGAUSS(46)/ .997263861849481564D0/ | |
6232 | DATA XGAUSS(47)/-.0483076656877383162D0/ | |
6233 | DATA XGAUSS(48)/-.144471961582796493D0/ | |
6234 | DATA XGAUSS(49)/-.239287362252137075D0/ | |
6235 | DATA XGAUSS(50)/-.331868602282127650D0/ | |
6236 | DATA XGAUSS(51)/-.421351276130635345D0/ | |
6237 | DATA XGAUSS(52)/-.506899908932229390D0/ | |
6238 | DATA XGAUSS(53)/-.587715757240762329D0/ | |
6239 | DATA XGAUSS(54)/-.663044266930215201D0/ | |
6240 | DATA XGAUSS(55)/-.732182118740289680D0/ | |
6241 | DATA XGAUSS(56)/-.794483795967942407D0/ | |
6242 | DATA XGAUSS(57)/-.849367613732569970D0/ | |
6243 | DATA XGAUSS(58)/-.896321155766052124D0/ | |
6244 | DATA XGAUSS(59)/-.934906075937739689D0/ | |
6245 | DATA XGAUSS(60)/-.964762255587506430D0/ | |
6246 | DATA XGAUSS(61)/-.985611511545268335D0/ | |
6247 | DATA XGAUSS(62)/-.997263861849481564D0/ | |
6248 | DATA WGAUSS(31)/ .0965400885147278006D0/ | |
6249 | DATA WGAUSS(32)/ .0956387200792748594D0/ | |
6250 | DATA WGAUSS(33)/ .0938443990808045654D0/ | |
6251 | DATA WGAUSS(34)/ .0911738786957638847D0/ | |
6252 | DATA WGAUSS(35)/ .0876520930044038111D0/ | |
6253 | DATA WGAUSS(36)/ .0833119242269467552D0/ | |
6254 | DATA WGAUSS(37)/ .0781938957870703065D0/ | |
6255 | DATA WGAUSS(38)/ .0723457941088485062D0/ | |
6256 | DATA WGAUSS(39)/ .0658222227763618468D0/ | |
6257 | DATA WGAUSS(40)/ .0586840934785355471D0/ | |
6258 | DATA WGAUSS(41)/ .0509980592623761762D0/ | |
6259 | DATA WGAUSS(42)/ .0428358980222266807D0/ | |
6260 | DATA WGAUSS(43)/ .0342738629130214331D0/ | |
6261 | DATA WGAUSS(44)/ .0253920653092620595D0/ | |
6262 | DATA WGAUSS(45)/ .0162743947309056706D0/ | |
6263 | DATA WGAUSS(46)/ .00701861000947009660D0/ | |
6264 | DATA WGAUSS(47)/ .0965400885147278006D0/ | |
6265 | DATA WGAUSS(48)/ .0956387200792748594D0/ | |
6266 | DATA WGAUSS(49)/ .0938443990808045654D0/ | |
6267 | DATA WGAUSS(50)/ .0911738786957638847D0/ | |
6268 | DATA WGAUSS(51)/ .0876520930044038111D0/ | |
6269 | DATA WGAUSS(52)/ .0833119242269467552D0/ | |
6270 | DATA WGAUSS(53)/ .0781938957870703065D0/ | |
6271 | DATA WGAUSS(54)/ .0723457941088485062D0/ | |
6272 | DATA WGAUSS(55)/ .0658222227763618468D0/ | |
6273 | DATA WGAUSS(56)/ .0586840934785355471D0/ | |
6274 | DATA WGAUSS(57)/ .0509980592623761762D0/ | |
6275 | DATA WGAUSS(58)/ .0428358980222266807D0/ | |
6276 | DATA WGAUSS(59)/ .0342738629130214331D0/ | |
6277 | DATA WGAUSS(60)/ .0253920653092620595D0/ | |
6278 | DATA WGAUSS(61)/ .0162743947309056706D0/ | |
6279 | DATA WGAUSS(62)/ .00701861000947009660D0/ | |
6280 | ||
6281 | DATA XGAUSS(63)/ .02435029266342443250D0/ | |
6282 | DATA XGAUSS(64)/ .0729931217877990394D0/ | |
6283 | DATA XGAUSS(65)/ .121462819296120554D0/ | |
6284 | DATA XGAUSS(66)/ .169644420423992818D0/ | |
6285 | DATA XGAUSS(67)/ .217423643740007084D0/ | |
6286 | DATA XGAUSS(68)/ .264687162208767416D0/ | |
6287 | DATA XGAUSS(69)/ .311322871990210956D0/ | |
6288 | DATA XGAUSS(70)/ .357220158337668116D0/ | |
6289 | DATA XGAUSS(71)/ .402270157963991604D0/ | |
6290 | DATA XGAUSS(72)/ .446366017253464088D0/ | |
6291 | DATA XGAUSS(73)/ .489403145707052957D0/ | |
6292 | DATA XGAUSS(74)/ .531279464019894546D0/ | |
6293 | DATA XGAUSS(75)/ .571895646202634034D0/ | |
6294 | DATA XGAUSS(76)/ .611155355172393250D0/ | |
6295 | DATA XGAUSS(77)/ .648965471254657340D0/ | |
6296 | DATA XGAUSS(78)/ .685236313054233243D0/ | |
6297 | DATA XGAUSS(79)/ .719881850171610827D0/ | |
6298 | DATA XGAUSS(80)/ .752819907260531897D0/ | |
6299 | DATA XGAUSS(81)/ .783972358943341408D0/ | |
6300 | DATA XGAUSS(82)/ .813265315122797560D0/ | |
6301 | DATA XGAUSS(83)/ .840629296252580363D0/ | |
6302 | DATA XGAUSS(84)/ .865999398154092820D0/ | |
6303 | DATA XGAUSS(85)/ .889315445995114106D0/ | |
6304 | DATA XGAUSS(86)/ .910522137078502806D0/ | |
6305 | DATA XGAUSS(87)/ .929569172131939576D0/ | |
6306 | DATA XGAUSS(88)/ .946411374858402816D0/ | |
6307 | DATA XGAUSS(89)/ .961008799652053719D0/ | |
6308 | DATA XGAUSS(90)/ .973326827789910964D0/ | |
6309 | DATA XGAUSS(91)/ .983336253884625957D0/ | |
6310 | DATA XGAUSS(92)/ .991013371476744321D0/ | |
6311 | DATA XGAUSS(93)/ .996340116771955279D0/ | |
6312 | DATA XGAUSS(94)/ .999305041735772139D0/ | |
6313 | DATA XGAUSS(95)/-.02435029266342443250D0/ | |
6314 | DATA XGAUSS(96)/-.0729931217877990394D0/ | |
6315 | DATA XGAUSS(97)/-.121462819296120554D0/ | |
6316 | DATA XGAUSS(98)/-.169644420423992818D0/ | |
6317 | DATA XGAUSS(99)/-.217423643740007084D0/ | |
6318 | DATA XGAUSS(100)/-.264687162208767416D0/ | |
6319 | DATA XGAUSS(101)/-.311322871990210956D0/ | |
6320 | DATA XGAUSS(102)/-.357220158337668116D0/ | |
6321 | DATA XGAUSS(103)/-.402270157963991604D0/ | |
6322 | DATA XGAUSS(104)/-.446366017253464088D0/ | |
6323 | DATA XGAUSS(105)/-.489403145707052957D0/ | |
6324 | DATA XGAUSS(106)/-.531279464019894546D0/ | |
6325 | DATA XGAUSS(107)/-.571895646202634034D0/ | |
6326 | DATA XGAUSS(108)/-.611155355172393250D0/ | |
6327 | DATA XGAUSS(109)/-.648965471254657340D0/ | |
6328 | DATA XGAUSS(110)/-.685236313054233243D0/ | |
6329 | DATA XGAUSS(111)/-.719881850171610827D0/ | |
6330 | DATA XGAUSS(112)/-.752819907260531897D0/ | |
6331 | DATA XGAUSS(113)/-.783972358943341408D0/ | |
6332 | DATA XGAUSS(114)/-.813265315122797560D0/ | |
6333 | DATA XGAUSS(115)/-.840629296252580363D0/ | |
6334 | DATA XGAUSS(116)/-.865999398154092820D0/ | |
6335 | DATA XGAUSS(117)/-.889315445995114106D0/ | |
6336 | DATA XGAUSS(118)/-.910522137078502806D0/ | |
6337 | DATA XGAUSS(119)/-.929569172131939576D0/ | |
6338 | DATA XGAUSS(120)/-.946411374858402816D0/ | |
6339 | DATA XGAUSS(121)/-.961008799652053719D0/ | |
6340 | DATA XGAUSS(122)/-.973326827789910964D0/ | |
6341 | DATA XGAUSS(123)/-.983336253884625957D0/ | |
6342 | DATA XGAUSS(124)/-.991013371476744321D0/ | |
6343 | DATA XGAUSS(125)/-.996340116771955279D0/ | |
6344 | DATA XGAUSS(126)/-.999305041735772139D0/ | |
6345 | DATA WGAUSS(63)/ .0486909570091397204D0/ | |
6346 | DATA WGAUSS(64)/ .0485754674415034269D0/ | |
6347 | DATA WGAUSS(65)/ .0483447622348029572D0/ | |
6348 | DATA WGAUSS(66)/ .0479993885964583077D0/ | |
6349 | DATA WGAUSS(67)/ .0475401657148303087D0/ | |
6350 | DATA WGAUSS(68)/ .0469681828162100173D0/ | |
6351 | DATA WGAUSS(69)/ .0462847965813144172D0/ | |
6352 | DATA WGAUSS(70)/ .0454916279274181445D0/ | |
6353 | DATA WGAUSS(71)/ .0445905581637565631D0/ | |
6354 | DATA WGAUSS(72)/ .0435837245293234534D0/ | |
6355 | DATA WGAUSS(73)/ .0424735151236535890D0/ | |
6356 | DATA WGAUSS(74)/ .0412625632426235286D0/ | |
6357 | DATA WGAUSS(75)/ .0399537411327203414D0/ | |
6358 | DATA WGAUSS(76)/ .0385501531786156291D0/ | |
6359 | DATA WGAUSS(77)/ .0370551285402400460D0/ | |
6360 | DATA WGAUSS(78)/ .0354722132568823838D0/ | |
6361 | DATA WGAUSS(79)/ .0338051618371416094D0/ | |
6362 | DATA WGAUSS(80)/ .0320579283548515535D0/ | |
6363 | DATA WGAUSS(81)/ .0302346570724024789D0/ | |
6364 | DATA WGAUSS(82)/ .0283396726142594832D0/ | |
6365 | DATA WGAUSS(83)/ .0263774697150546587D0/ | |
6366 | DATA WGAUSS(84)/ .0243527025687108733D0/ | |
6367 | DATA WGAUSS(85)/ .0222701738083832542D0/ | |
6368 | DATA WGAUSS(86)/ .0201348231535302094D0/ | |
6369 | DATA WGAUSS(87)/ .0179517157756973431D0/ | |
6370 | DATA WGAUSS(88)/ .0157260304760247193D0/ | |
6371 | DATA WGAUSS(89)/ .0134630478967186426D0/ | |
6372 | DATA WGAUSS(90)/ .0111681394601311288D0/ | |
6373 | DATA WGAUSS(91)/ .00884675982636394772D0/ | |
6374 | DATA WGAUSS(92)/ .00650445796897836286D0/ | |
6375 | DATA WGAUSS(93)/ .00414703326056246764D0/ | |
6376 | DATA WGAUSS(94)/ .00178328072169643295D0/ | |
6377 | DATA WGAUSS(95)/ .0486909570091397204D0/ | |
6378 | DATA WGAUSS(96)/ .0485754674415034269D0/ | |
6379 | DATA WGAUSS(97)/ .0483447622348029572D0/ | |
6380 | DATA WGAUSS(98)/ .0479993885964583077D0/ | |
6381 | DATA WGAUSS(99)/ .0475401657148303087D0/ | |
6382 | DATA WGAUSS(100)/ .0469681828162100173D0/ | |
6383 | DATA WGAUSS(101)/ .0462847965813144172D0/ | |
6384 | DATA WGAUSS(102)/ .0454916279274181445D0/ | |
6385 | DATA WGAUSS(103)/ .0445905581637565631D0/ | |
6386 | DATA WGAUSS(104)/ .0435837245293234534D0/ | |
6387 | DATA WGAUSS(105)/ .0424735151236535890D0/ | |
6388 | DATA WGAUSS(106)/ .0412625632426235286D0/ | |
6389 | DATA WGAUSS(107)/ .0399537411327203414D0/ | |
6390 | DATA WGAUSS(108)/ .0385501531786156291D0/ | |
6391 | DATA WGAUSS(109)/ .0370551285402400460D0/ | |
6392 | DATA WGAUSS(110)/ .0354722132568823838D0/ | |
6393 | DATA WGAUSS(111)/ .0338051618371416094D0/ | |
6394 | DATA WGAUSS(112)/ .0320579283548515535D0/ | |
6395 | DATA WGAUSS(113)/ .0302346570724024789D0/ | |
6396 | DATA WGAUSS(114)/ .0283396726142594832D0/ | |
6397 | DATA WGAUSS(115)/ .0263774697150546587D0/ | |
6398 | DATA WGAUSS(116)/ .0243527025687108733D0/ | |
6399 | DATA WGAUSS(117)/ .0222701738083832542D0/ | |
6400 | DATA WGAUSS(118)/ .0201348231535302094D0/ | |
6401 | DATA WGAUSS(119)/ .0179517157756973431D0/ | |
6402 | DATA WGAUSS(120)/ .0157260304760247193D0/ | |
6403 | DATA WGAUSS(121)/ .0134630478967186426D0/ | |
6404 | DATA WGAUSS(122)/ .0111681394601311288D0/ | |
6405 | DATA WGAUSS(123)/ .00884675982636394772D0/ | |
6406 | DATA WGAUSS(124)/ .00650445796897836286D0/ | |
6407 | DATA WGAUSS(125)/ .00414703326056246764D0/ | |
6408 | DATA WGAUSS(126)/ .00178328072169643295D0/ | |
6409 | C | |
6410 | W1 = PGAM(4,1) | |
6411 | W2 = PGAM(4,2) | |
6412 | bmin = b1 - 2.D0*RADSRC(1) | |
6413 | IF (RADSRC(1) .GT. bmin) THEN | |
6414 | bmin = RADSRC(1) | |
6415 | ENDIF | |
6416 | bmax = b1 + 2.D0 * RADSRC(1) | |
6417 | ||
6418 | XINT = 0.D0 | |
6419 | DO 100 N=1,6 | |
6420 | XINT2 = XINT | |
6421 | XINT = 0.D0 | |
6422 | DO 200 I=2**N-1,2**(N+1)-2 | |
6423 | b2 = (bmax-bmin)/2.D0*XGAUSS(I)+(bmax+bmin)/2.D0 | |
6424 | XINT3 = PHO_GGFNUC(W1,b1,GAMSRC(1)) | |
6425 | & * PHO_GGFNUC(W2,b2,GAMSRC(2)) | |
6426 | & * ACOS ((b1**2+b2**2-4.D0*RADSRC(1)**2)/(2.D0*b1*b2)) | |
6427 | XINT = XINT +WGAUSS(I) * b2 * XINT3 | |
6428 | 200 CONTINUE | |
6429 | XINT = (bmax-bmin)/2.D0*XINT | |
6430 | IF (ABS((XINT2 - XINT)/XINT) .LT. ACCUR) GOTO 300 | |
6431 | 100 CONTINUE | |
6432 | WRITE(LO,*) ' (b2) GAUSS MAY BE INACCURATE' | |
6433 | 300 CONTINUE | |
6434 | ||
6435 | PHO_GGFAUX = XINT | |
6436 | ||
6437 | END | |
6438 | ||
6439 | *$ CREATE PHO_GGFNUC.FOR | |
6440 | *COPY PHO_GGFNUC | |
6441 | CDECK ID>, PHO_GGFNUC | |
6442 | DOUBLE PRECISION FUNCTION PHO_GGFNUC(W,Rho,Gamma) | |
6443 | C********************************************************************** | |
6444 | C | |
6445 | C differential photonnumber for a nucleus (geometrical model) | |
6446 | C (without form factor) | |
6447 | C | |
6448 | C********************************************************************* | |
6449 | IMPLICIT DOUBLE PRECISION (A-H,O-Z) | |
6450 | SAVE | |
6451 | ||
6452 | PARAMETER (PI = 3.14159265359D0) | |
6453 | ||
6454 | WGamma = W/Gamma | |
6455 | Wphib = WGamma * PHO_BESSK1(WGamma*Rho) | |
6456 | ||
6457 | PHO_GGFNUC = 1.D0/PI**2 * Wphib**2 | |
6458 | ||
6459 | END | |
6460 | ||
6461 | *$ CREATE PHO_GHHIOF.FOR | |
6462 | *COPY PHO_GHHIOF | |
6463 | CDECK ID>, PHO_GHHIOF | |
6464 | SUBROUTINE PHO_GHHIOF(NEVENT,EEN,NA,NZ) | |
6465 | C********************************************************************** | |
6466 | C | |
6467 | C interface to call PHOJET (variable energy run) for | |
6468 | C gamma-hadron collisions in heavy ion collisions | |
6469 | C (form factor approach) | |
6470 | C | |
6471 | C input: EEN LAB system energy per nucleon | |
6472 | C NA atomic number of ion/hadron | |
6473 | C NZ charge number of ion/hadron | |
6474 | C NEVENT number of events to generate | |
6475 | C from /LEPCUT/: | |
6476 | C YMIN1,2 lower limit of Y | |
6477 | C (energy fraction taken by photon from hadron) | |
6478 | C YMAX1,2 upper cutoff for Y, necessary to avoid | |
6479 | C underflows | |
6480 | C Q2MIN1,2 minimum Q**2 of photons (should be set to 0) | |
6481 | C Q2MAX1,2 maximum Q**2 of photons (if necessary, | |
6482 | C corrected according size of hadron) | |
6483 | C | |
6484 | C********************************************************************** | |
6485 | IMPLICIT DOUBLE PRECISION (A-H,O-Z) | |
6486 | SAVE | |
6487 | ||
6488 | PARAMETER ( PI = 3.14159265359D0 ) | |
6489 | ||
6490 | C input/output channels | |
6491 | INTEGER LI,LO | |
6492 | COMMON /POINOU/ LI,LO | |
6493 | C model switches and parameters | |
6494 | CHARACTER*8 MDLNA | |
6495 | INTEGER ISWMDL,IPAMDL | |
6496 | DOUBLE PRECISION PARMDL | |
6497 | COMMON /POMDLS/ MDLNA(50),ISWMDL(50),PARMDL(400),IPAMDL(400) | |
6498 | C event debugging information | |
6499 | INTEGER NMAXD | |
6500 | PARAMETER (NMAXD=100) | |
6501 | INTEGER IDEB,KSPOM,KHPOM,KSREG,KHDIR,KACCEP,KSTRG,KHTRG,KSLOO, | |
6502 | & KHLOO,KSDPO,KHDPO,KEVENT,KSOFT,KHARD | |
6503 | COMMON /PODEBG/ IDEB(NMAXD),KSPOM,KHPOM,KSREG,KHDIR,KACCEP,KSTRG, | |
6504 | & KHTRG,KSLOO,KHLOO,KSDPO,KHDPO,KEVENT,KSOFT,KHARD | |
6505 | C photon flux kinematics and cuts | |
6506 | DOUBLE PRECISION ECMIN,ECMAX,EEMIN1,EEMIN2, | |
6507 | & YMIN1,YMAX1,YMIN2,YMAX2, | |
6508 | & Q2MIN1,Q2MAX1,Q2MIN2,Q2MAX2, | |
6509 | & THMIN1,THMAX1,THMIN2,THMAX2 | |
6510 | INTEGER ITAG1,ITAG2 | |
6511 | COMMON /POFCUT/ ECMIN,ECMAX,EEMIN1,EEMIN2, | |
6512 | & YMIN1,YMAX1,YMIN2,YMAX2, | |
6513 | & Q2MIN1,Q2MAX1,Q2MIN2,Q2MAX2, | |
6514 | & THMIN1,THMAX1,THMIN2,THMAX2, | |
6515 | & ITAG1,ITAG2 | |
6516 | C gamma-lepton or gamma-hadron vertex information | |
6517 | INTEGER IGHEL,IDPSRC,IDBSRC | |
6518 | DOUBLE PRECISION PINI,PFIN,PGAM,GYY,GQ2,GGECM,GAIMP,PFTHE,PFPHI, | |
6519 | & RADSRC,AMSRC,GAMSRC | |
6520 | COMMON /POFSRC/ PINI(5,2),PFIN(5,2),PGAM(5,2),IGHEL(2), | |
6521 | & GYY(2),GQ2(2),GGECM,GAIMP(2),PFTHE(2),PFPHI(2), | |
6522 | & IDPSRC(2),IDBSRC(2),RADSRC(2),AMSRC(2),GAMSRC(2) | |
6523 | C nucleon-nucleus / nucleus-nucleus interface to DPMJET | |
6524 | INTEGER IDEQP,IDEQB,IHFLD,IHFLS | |
6525 | DOUBLE PRECISION ECMN,PCMN,SECM,SPCM,XPSUB,XTSUB | |
6526 | COMMON /POHDFL/ ECMN,PCMN,SECM,SPCM,XPSUB,XTSUB, | |
6527 | & IDEQP(2),IDEQB(2),IHFLD(2,2),IHFLS(2) | |
6528 | C standard particle data interface | |
6529 | INTEGER NMXHEP | |
6530 | PARAMETER (NMXHEP=4000) | |
6531 | INTEGER NEVHEP,NHEP,ISTHEP,IDHEP,JMOHEP,JDAHEP | |
6532 | DOUBLE PRECISION PHEP,VHEP | |
6533 | COMMON /POEVT1/ NEVHEP,NHEP,ISTHEP(NMXHEP),IDHEP(NMXHEP), | |
6534 | & JMOHEP(2,NMXHEP),JDAHEP(2,NMXHEP),PHEP(5,NMXHEP), | |
6535 | & VHEP(4,NMXHEP) | |
6536 | C extension to standard particle data interface (PHOJET specific) | |
6537 | INTEGER IMPART,IPHIST,ICOLOR | |
6538 | COMMON /POEVT2/ IMPART(NMXHEP),IPHIST(2,NMXHEP),ICOLOR(2,NMXHEP) | |
6539 | C event weights and generated cross section | |
6540 | INTEGER IPOWGC,ISWCUT,IVWGHT | |
6541 | DOUBLE PRECISION SIGGEN,HSWGHT,HSWCUT,EVWGHT | |
6542 | COMMON /POWGHT/ SIGGEN(4),HSWGHT(0:10),HSWCUT(20),EVWGHT(0:10), | |
6543 | & IPOWGC(0:10),ISWCUT(20),IVWGHT(0:10) | |
6544 | ||
6545 | DIMENSION P1(4),P2(4) | |
6546 | DIMENSION NITERS(2),ITRW(2) | |
6547 | ||
6548 | WRITE(LO,'(2(/1X,A))') | |
6549 | & 'PHO_GHHIOF: gamma-hadron event generation', | |
6550 | & '-----------------------------------------' | |
6551 | C hadron size and mass | |
6552 | FM2GEV = 5.07D0 | |
6553 | HIMASS = DBLE(NA)*0.938D0 | |
6554 | HIMA2 = HIMASS**2 | |
6555 | HIRADI = 1.2D0*FM2GEV*DBLE(NA)**0.333 | |
6556 | ALPHA = DBLE(NZ**2)/137.D0 | |
6557 | AMP = 0.938D0 | |
6558 | AMP2 = AMP**2 | |
6559 | C correct Q2MAX1,2 according to hadron size | |
6560 | Q2MAXH = 2.D0/HIRADI**2 | |
6561 | Q2MAX1 = MIN(Q2MAX1,Q2MAXH) | |
6562 | Q2MAX2 = MIN(Q2MAX2,Q2MAXH) | |
6563 | IF(Q2MAX1.LT.1.D-20) Q2MAX1 = Q2MAXH | |
6564 | IF(Q2MAX2.LT.1.D-20) Q2MAX2 = Q2MAXH | |
6565 | C total hadron / heavy ion energy | |
6566 | EE = EEN*DBLE(NA) | |
6567 | GAMMA = EE/HIMASS | |
6568 | C setup /POFSRC/ | |
6569 | GAMSRC(1) = GAMMA | |
6570 | GAMSRC(2) = GAMMA | |
6571 | RADSRC(1) = HIRADI | |
6572 | RADSRC(2) = HIRADI | |
6573 | AMSRC(1) = HIMASS | |
6574 | AMSRC(2) = HIMASS | |
6575 | C check cuts on photon-hadron mass | |
6576 | IF((0.765D0+PARMDL(46)).GT.(PARMDL(45)*ECMIN)) THEN | |
6577 | YMI = ECMIN | |
6578 | ECMIN = PARMDL(46)/PARMDL(45)+0.1D0 | |
6579 | WRITE(LO,'(/1X,A,2E12.5)') | |
6580 | & 'PHO_GHHIOF: ecmin corrected to (old/new)',YMI,ECMIN | |
6581 | ENDIF | |
6582 | C check kinematic limitations | |
6583 | YMI = ECMIN**2/(4.D0*EE*EEN) | |
6584 | IF(YMIN1.LT.YMI) THEN | |
6585 | WRITE(LO,'(/1X,A,2E12.5)') | |
6586 | & 'PHO_GHHIOF: ymin1 increased to (old/new)',YMIN1,YMI | |
6587 | YMIN1 = YMI | |
6588 | ELSE IF(YMIN1.GT.YMI) THEN | |
6589 | WRITE(LO,'(/1X,A,/1X,A,E12.5,A,E12.5)') | |
6590 | & 'PHO_GHHIOF:','ECM-CUT CORRESPONDS TO YMIN1 OF',YMI, | |
6591 | & ' INSTEAD OF',YMIN1 | |
6592 | ENDIF | |
6593 | IF(YMIN2.LT.YMI) THEN | |
6594 | WRITE(LO,'(/1X,A,2E12.5)') | |
6595 | & 'PHO_GHHIOF: ymin2 increased to (old/new)',YMIN2,YMI | |
6596 | YMIN2 = YMI | |
6597 | ELSE IF(YMIN2.GT.YMI) THEN | |
6598 | WRITE(LO,'(/1X,A,/1X,A,E12.5,A,E12.5)') | |
6599 | & 'PHO_GHHIOF:','ECM-CUT CORRESPONDS TO YMIN2 OF',YMI, | |
6600 | & ' INSTEAD OF',YMIN2 | |
6601 | ENDIF | |
6602 | C kinematic limitation | |
6603 | Q2LOW1 = MAX(Q2MIN1,HIMA2*YMIN1**2/(1.D0-YMIN1)) | |
6604 | Q2LOW2 = MAX(Q2MIN2,HIMA2*YMIN2**2/(1.D0-YMIN2)) | |
6605 | C debug output | |
6606 | WRITE(LO,'(/6X,A,2I4)') 'MASS NUMBER, CHARGE NUMBER ',NA,NZ | |
6607 | WRITE(LO,'(6X,A,E12.5)') 'HADRON MASS (GeV) ',HIMASS | |
6608 | WRITE(LO,'(6X,A,E12.5)') 'HADRON RADIUS (GeV**-1) ',HIRADI | |
6609 | WRITE(LO,'(6X,A,2E12.5)') 'Q**2 RANGE PHOTON 1 (GEV**2)',Q2LOW1, | |
6610 | & Q2MAX1 | |
6611 | WRITE(LO,'(6X,A,2E12.5)') 'Q**2 RANGE PHOTON 2 (GEV**2)',Q2LOW2, | |
6612 | & Q2MAX2 | |
6613 | WRITE(LO,'(6X,A,2E12.5)') 'Y RANGE PHOTON 1 ',YMIN1, | |
6614 | & YMAX1 | |
6615 | WRITE(LO,'(6X,A,2E12.5)') 'Y RANGE PHOTON 2 ',YMIN2, | |
6616 | & YMAX2 | |
6617 | WRITE(LO,'(6X,A,2E12.5)') 'SQRT(S) PER NUCLEON, TOTAL ', | |
6618 | & 2.D0*EEN,2.D0*EE | |
6619 | WRITE(LO,'(6X,A,2E12.5)') 'INV.MASS PHOTON-HADRON ',ECMIN, | |
6620 | & ECMAX | |
6621 | WRITE(LO,'(6X,A,E12.5)') 'MIN. INV.MASS PHOTON-POMERON', | |
6622 | & PARMDL(175) | |
6623 | WRITE(LO,'(6X,A,I10)') 'EVENTS TO PROCESS ',NEVENT | |
6624 | IF(Q2LOW1.GE.Q2MAX1) THEN | |
6625 | WRITE(LO,'(/1X,A,2E12.4)') | |
6626 | & 'PHO_GHHIOF:ERROR:INCONSISTENT Q**2 RANGE 1',Q2LOW1,Q2MAX1 | |
6627 | CALL PHO_ABORT | |
6628 | ENDIF | |
6629 | IF(Q2LOW2.GE.Q2MAX2) THEN | |
6630 | WRITE(LO,'(/1X,A,2E12.4)') | |
6631 | & 'PHO_GHHIOF:ERROR:INCONSISTENT Q**2 RANGE 2',Q2LOW2,Q2MAX2 | |
6632 | CALL PHO_ABORT | |
6633 | ENDIF | |
6634 | C hadron numbers set to 0 | |
6635 | IDPSRC(1) = 0 | |
6636 | IDPSRC(2) = 0 | |
6637 | IDBSRC(1) = 0 | |
6638 | IDBSRC(2) = 0 | |
6639 | C | |
6640 | Max_tab = 100 | |
6641 | YMAX = YMAX1 | |
6642 | YMIN = YMIN1 | |
6643 | XMAX = LOG(YMAX) | |
6644 | XMIN = LOG(YMIN) | |
6645 | XDEL = XMAX-XMIN | |
6646 | DELLY = LOG(YMAX/YMIN)/DBLE(Max_tab-1) | |
6647 | DO 100 I=1,Max_tab | |
6648 | Y1 = EXP(XMIN+DELLY*DBLE(I-1)) | |
6649 | Q2LOW1 = MAX(Q2MIN1,HIMA2*Y1*Y1/(1.D0-Y1)) | |
6650 | IF(Q2LOW1.GE.Q2MAX1) THEN | |
6651 | WRITE(LO,'(/1X,A,2E12.4)') | |
6652 | & 'PHO_GHHIOF: ymax1 changed from/to',YMAX1,Y1 | |
6653 | YMAX1 = MIN(Y1,YMAX1) | |
6654 | GOTO 101 | |
6655 | ENDIF | |
6656 | 100 CONTINUE | |
6657 | 101 CONTINUE | |
6658 | YMAX = YMAX2 | |
6659 | YMIN = YMIN2 | |
6660 | XMAX = LOG(YMAX) | |
6661 | XMIN = LOG(YMIN) | |
6662 | XDEL = XMAX-XMIN | |
6663 | DELLY = LOG(YMAX/YMIN)/DBLE(Max_tab-1) | |
6664 | DO 102 I=1,Max_tab | |
6665 | Y1 = EXP(XMIN+DELLY*DBLE(I-1)) | |
6666 | Q2LOW2 = MAX(Q2MIN2,HIMA2*Y1*Y1/(1.D0-Y1)) | |
6667 | IF(Q2LOW2.GE.Q2MAX2) THEN | |
6668 | WRITE(LO,'(/1X,A,2E12.4)') | |
6669 | & 'PHO_GHHIOF: ymax2 changed from/to',YMAX2,Y1 | |
6670 | YMAX2 = MIN(Y1,YMAX2) | |
6671 | GOTO 103 | |
6672 | ENDIF | |
6673 | 102 CONTINUE | |
6674 | 103 CONTINUE | |
6675 | C | |
6676 | X1MAX = LOG(YMAX1) | |
6677 | X1MIN = LOG(YMIN1) | |
6678 | X1DEL = X1MAX-X1MIN | |
6679 | X2MAX = LOG(YMAX2) | |
6680 | X2MIN = LOG(YMIN2) | |
6681 | X2DEL = X2MAX-X2MIN | |
6682 | DELLY = LOG(YMAX1/YMIN1)/DBLE(Max_tab-1) | |
6683 | FLUX = 0.D0 | |
6684 | IF(IDEB(30).GE.1) WRITE(LO,'(/1X,A,I5)') | |
6685 | & 'PHO_GHHIOF: table of raw photon flux (side 1)',Max_tab | |
6686 | DO 105 I=1,Max_tab | |
6687 | Y1 = EXP(X1MIN+DELLY*DBLE(I-1)) | |
6688 | Q2LOW1 = MAX(Q2MIN1,HIMA2*Y1*Y1/(1.D0-Y1)) | |
6689 | FF = ((1.D0+(1.D0-Y1)**2)/Y1*LOG(Q2MAX1/Q2LOW1) | |
6690 | & -2.D0*HIMA2*Y1*(1.D0/Q2LOW1-1.D0/Q2MAX1))*ALPHA/(2.D0*PI) | |
6691 | FLUX = FLUX+Y1*FF | |
6692 | IF(IDEB(30).GE.1) WRITE(LO,'(5X,2E15.4)') Y1,FF | |
6693 | 105 CONTINUE | |
6694 | FLUX = FLUX*DELLY | |
6695 | IF(IDEB(30).GE.1) WRITE(LO,'(1X,A,E12.4)') | |
6696 | & 'PHO_GHHIOF: integrated flux (one side):',FLUX | |
6697 | C | |
6698 | C photon | |
6699 | EGAM = MAX(YMAX1,YMAX2)*EE | |
6700 | P1(1) = 0.D0 | |
6701 | P1(2) = 0.D0 | |
6702 | P1(3) = EGAM | |
6703 | P1(4) = EGAM | |
6704 | C hadron | |
6705 | P2(1) = 0.D0 | |
6706 | P2(2) = 0.D0 | |
6707 | P2(3) = -SQRT(EEN**2-AMP2) | |
6708 | P2(4) = EEN | |
6709 | CALL PHO_SETPAR(1,22,0,0.D0) | |
6710 | CALL PHO_SETPAR(2,2212,0,0.D0) | |
6711 | CALL PHO_EVENT(-1,P1,P2,SIGMAX,IREJ) | |
6712 | C | |
6713 | Q2LOW1 = MAX(Q2MIN1,HIMA2*YMIN1**2/(1.D0-YMIN1)) | |
6714 | Q2LOW2 = MAX(Q2MIN2,HIMA2*YMIN2**2/(1.D0-YMIN2)) | |
6715 | Y1 = YMIN1 | |
6716 | Y2 = YMIN2 | |
6717 | WGMAX1 = (1.D0+(1.D0-Y1)**2)*LOG(Q2MAX1/Q2LOW1) | |
6718 | & -2.D0*HIMA2*Y1*(1.D0/Q2LOW1-1.D0/Q2MAX1)*Y1 | |
6719 | WGMAX2 = (1.D0+(1.D0-Y2)**2)*LOG(Q2MAX2/Q2LOW2) | |
6720 | & -2.D0*HIMA2*Y2*(1.D0/Q2LOW2-1.D0/Q2MAX2)*Y2 | |
6721 | C | |
6722 | IF(IPAMDL(175).EQ.1) WGMAX2 = 0.D0 | |
6723 | IF(IPAMDL(175).EQ.2) WGMAX1 = 0.D0 | |
6724 | C | |
6725 | FAC12 = WGMAX1*LOG(YMAX1/YMIN1) | |
6726 | & /(WGMAX1*LOG(YMAX1/YMIN1)+WGMAX2*LOG(YMAX2/YMIN2)) | |
6727 | C | |
6728 | CALL PHO_PHIST(-1,SIGMAX) | |
6729 | CALL PHO_LHIST(-1,SIGMAX) | |
6730 | C | |
6731 | C generation of events, flux calculation | |
6732 | AY1 = 0.D0 | |
6733 | AY2 = 0.D0 | |
6734 | AYS1 = 0.D0 | |
6735 | AYS2 = 0.D0 | |
6736 | Q21MIN = 1.D30 | |
6737 | Q22MIN = 1.D30 | |
6738 | Q21MAX = 0.D0 | |
6739 | Q22MAX = 0.D0 | |
6740 | Q21AVE = 0.D0 | |
6741 | Q22AVE = 0.D0 | |
6742 | Q21AV2 = 0.D0 | |
6743 | Q22AV2 = 0.D0 | |
6744 | YY1MIN = 1.D30 | |
6745 | YY2MIN = 1.D30 | |
6746 | YY1MAX = 0.D0 | |
6747 | YY2MAX = 0.D0 | |
6748 | NITER = NEVENT | |
6749 | NITERS(1) = 0 | |
6750 | NITERS(2) = 0 | |
6751 | ITRY = 0 | |
6752 | ITRW(1) = 0 | |
6753 | ITRW(2) = 0 | |
6754 | DO 200 I=1,NITER | |
6755 | C sample y1, y2 | |
6756 | 150 CONTINUE | |
6757 | ITRY = ITRY+1 | |
6758 | 175 CONTINUE | |
6759 | C | |
6760 | C select side of photon emission | |
6761 | IF(DT_RNDM(AY1).LT.FAC12) THEN | |
6762 | ITRW(1) = ITRW(1)+1 | |
6763 | C select Y1 | |
6764 | Y1 = EXP(X1DEL*DT_RNDM(AY1)+X1MIN) | |
6765 | Q2LOW1 = MAX(Q2MIN1,HIMA2*Y1**2/(1.D0-Y1)) | |
6766 | IF(Q2LOW1.GE.Q2MAX1) GOTO 175 | |
6767 | Q2LOG1 = LOG(Q2MAX1/Q2LOW1) | |
6768 | WGH = (1.D0+(1.D0-Y1)**2)*Q2LOG1 | |
6769 | & -2.D0*HIMA2*Y1*(1.D0/Q2LOW1-1.D0/Q2MAX1)*Y1 | |
6770 | IF(WGMAX1.LT.WGH) WRITE(LO,'(1X,A,3E12.5)') | |
6771 | & 'PHO_GHHIOF:WEIGHT ERROR (1):',Y1,WGMAX1,WGH | |
6772 | IF(DT_RNDM(AYS1)*WGMAX1.GT.WGH) GOTO 175 | |
6773 | C sample Q2 | |
6774 | IF(IPAMDL(174).EQ.1) THEN | |
6775 | YEFF = 1.D0+(1.D0-Y1)**2 | |
6776 | 185 CONTINUE | |
6777 | Q2P1 = Q2LOW1*EXP(Q2LOG1*DT_RNDM(Y1)) | |
6778 | WEIGHT = (YEFF-2.D0*(1.D0-Y1)*Q2LOW1/Q2P1)/YEFF | |
6779 | IF(WEIGHT.LT.DT_RNDM(Q2P1)) GOTO 185 | |
6780 | ELSE | |
6781 | Q2P1 = Q2LOW1 | |
6782 | ENDIF | |
6783 | C impact parameter | |
6784 | GAIMP(1) = 1.D0/SQRT(Q2P1) | |
6785 | C form factor (squared) | |
6786 | FF2 = 1.D0 | |
6787 | IF(GAIMP(1).LT.2.D0*HIRADI) FF2 = 0.D0 | |
6788 | IF(DT_RNDM(Q2P1).GE.FF2) GOTO 175 | |
6789 | C photon data | |
6790 | GYY(1) = Y1 | |
6791 | GQ2(1) = Q2P1 | |
6792 | C | |
6793 | C incoming hadron 1 | |
6794 | PINI(1,1) = 0.D0 | |
6795 | PINI(2,1) = 0.D0 | |
6796 | PINI(3,1) = SQRT(EE**2-AMP2) | |
6797 | PINI(4,1) = EE | |
6798 | PINI(5,1) = AMP | |
6799 | C outgoing hadron 1 | |
6800 | YQ2 = SQRT((1.D0-Y1)*Q2P1) | |
6801 | Q2E = Q2P1/(4.D0*EE) | |
6802 | E1Y = EE*(1.D0-Y1) | |
6803 | CALL PHO_SFECFE(SIF,COF) | |
6804 | PFIN(1,1) = YQ2*COF | |
6805 | PFIN(2,1) = YQ2*SIF | |
6806 | PFIN(3,1) = E1Y-Q2E | |
6807 | PFIN(4,1) = E1Y+Q2E | |
6808 | PFIN(5,1) = 0.D0 | |
6809 | PFPHI(1) = ATAN2(COF,SIF) | |
6810 | PFTHE(1) = ACOS((E1Y-Q2E)/(Q2E+E1Y)) | |
6811 | C incoming hadron 2 | |
6812 | PINI(1,2) = 0.D0 | |
6813 | PINI(2,2) = 0.D0 | |
6814 | PINI(3,2) = -SQRT(EE**2-AMP2) | |
6815 | PINI(4,2) = EE | |
6816 | PINI(5,2) = AMP | |
6817 | C scattering photon | |
6818 | P1(1) = -PFIN(1,1) | |
6819 | P1(2) = -PFIN(2,1) | |
6820 | P1(3) = PINI(3,1)-PFIN(3,1) | |
6821 | P1(4) = PINI(4,1)-PFIN(4,1) | |
6822 | C scattering hadron | |
6823 | P2(1) = 0.D0 | |
6824 | P2(2) = 0.D0 | |
6825 | P2(3) = -SQRT(EEN**2-AMP2) | |
6826 | P2(4) = EEN | |
6827 | ISIDE = 1 | |
6828 | C | |
6829 | ELSE | |
6830 | C | |
6831 | ITRW(2) = ITRW(2)+1 | |
6832 | C select Y2 | |
6833 | Y2 = EXP(X2DEL*DT_RNDM(AY2)+X2MIN) | |
6834 | Q2LOW2 = MAX(Q2MIN2,HIMA2*Y2**2/(1.D0-Y2)) | |
6835 | IF(Q2LOW2.GE.Q2MAX2) GOTO 175 | |
6836 | Q2LOG2 = LOG(Q2MAX2/Q2LOW2) | |
6837 | WGH = (1.D0+(1.D0-Y2)**2)*Q2LOG2 | |
6838 | & -2.D0*HIMA2*Y2*(1.D0/Q2LOW2-1.D0/Q2MAX2)*Y2 | |
6839 | IF(WGMAX2.LT.WGH) WRITE(LO,'(1X,A,3E12.5)') | |
6840 | & 'PHO_GHHIOF:WEIGHT ERROR (2):',Y2,WGMAX2,WGH | |
6841 | IF(DT_RNDM(AYS1)*WGMAX2.GT.WGH) GOTO 175 | |
6842 | C sample Q2 | |
6843 | IF(IPAMDL(174).EQ.1) THEN | |
6844 | YEFF = 1.D0+(1.D0-Y2)**2 | |
6845 | 186 CONTINUE | |
6846 | Q2P2 = Q2LOW2*EXP(Q2LOG2*DT_RNDM(Y2)) | |
6847 | WEIGHT = (YEFF-2.D0*(1.D0-Y2)*Q2LOW2/Q2P2)/YEFF | |
6848 | IF(WEIGHT.LT.DT_RNDM(Q2P2)) GOTO 186 | |
6849 | ELSE | |
6850 | Q2P2 = Q2LOW2 | |
6851 | ENDIF | |
6852 | C impact parameter | |
6853 | GAIMP(2) = 1.D0/SQRT(Q2P2) | |
6854 | C form factor (squared) | |
6855 | FF2 = 1.D0 | |
6856 | IF(GAIMP(2).LT.2.D0*HIRADI) FF2 = 0.D0 | |
6857 | IF(DT_RNDM(Q2P2).GE.FF2) GOTO 175 | |
6858 | C photon data | |
6859 | GYY(2) = Y2 | |
6860 | GQ2(2) = Q2P2 | |
6861 | C | |
6862 | C incoming hadron 1 | |
6863 | PINI(1,1) = 0.D0 | |
6864 | PINI(2,1) = 0.D0 | |
6865 | PINI(3,1) = SQRT(EE**2-AMP2) | |
6866 | PINI(4,1) = EE | |
6867 | PINI(5,1) = AMP | |
6868 | C incoming hadron 2 | |
6869 | PINI(1,2) = 0.D0 | |
6870 | PINI(2,2) = 0.D0 | |
6871 | PINI(3,2) = -SQRT(EE**2-AMP2) | |
6872 | PINI(4,2) = EE | |
6873 | PINI(5,2) = AMP | |
6874 | C outgoing hadron 2 | |
6875 | YQ2 = SQRT((1.D0-Y2)*Q2P2) | |
6876 | Q2E = Q2P2/(4.D0*EE) | |
6877 | E1Y = EE*(1.D0-Y2) | |
6878 | CALL PHO_SFECFE(SIF,COF) | |
6879 | PFIN(1,2) = YQ2*COF | |
6880 | PFIN(2,2) = YQ2*SIF | |
6881 | PFIN(3,2) = -E1Y+Q2E | |
6882 | PFIN(4,2) = E1Y+Q2E | |
6883 | PFIN(5,2) = 0.D0 | |
6884 | PFPHI(2) = ATAN2(COF,SIF) | |
6885 | PFTHE(2) = ACOS((Q2E-E1Y)/(Q2E+E1Y)) | |
6886 | C scattering hadron | |
6887 | P2(1) = 0.D0 | |
6888 | P2(2) = 0.D0 | |
6889 | P2(3) = SQRT(EEN**2-AMP2) | |
6890 | P2(4) = EEN | |
6891 | C scattering photon | |
6892 | P1(1) = -PFIN(1,2) | |
6893 | P1(2) = -PFIN(2,2) | |
6894 | P1(3) = PINI(3,2)-PFIN(3,2) | |
6895 | P1(4) = PINI(4,2)-PFIN(4,2) | |
6896 | ISIDE = 2 | |
6897 | ENDIF | |
6898 | C ECMS cut | |
6899 | GGECM = (P1(4)+P2(4))**2-(P1(1)+P2(1))**2 | |
6900 | & -(P1(2)+P2(2))**2-(P1(3)+P2(3))**2 | |
6901 | IF(GGECM.LT.0.1D0) GOTO 175 | |
6902 | GGECM = SQRT(GGECM) | |
6903 | IF((GGECM.LT.ECMIN).OR.(GGECM.GT.ECMAX)) GOTO 175 | |
6904 | C | |
6905 | PGAM(1,1) = P1(1) | |
6906 | PGAM(2,1) = P1(2) | |
6907 | PGAM(3,1) = P1(3) | |
6908 | PGAM(4,1) = P1(4) | |
6909 | PGAM(5,1) = -SQRT(Q2P1) | |
6910 | PGAM(1,2) = P2(1) | |
6911 | PGAM(2,2) = P2(2) | |
6912 | PGAM(3,2) = P2(3) | |
6913 | PGAM(4,2) = P2(4) | |
6914 | PGAM(5,2) = -SQRT(Q2P2) | |
6915 | CALL PHO_PRESEL(5,IREJ) | |
6916 | C photon helicities | |
6917 | IGHEL(1) = 1 | |
6918 | IGHEL(2) = 1 | |
6919 | C user cuts | |
6920 | IF(IREJ.NE.0) GOTO 175 | |
6921 | C event generation | |
6922 | CALL PHO_EVENT(1,P1,P2,SIGCUR,IREJ) | |
6923 | IF(IREJ.NE.0) GOTO 150 | |
6924 | C cut on diffractive mass | |
6925 | DO 250 K=1,NHEP | |
6926 | IF(ISTHEP(K).EQ.30) THEN | |
6927 | GHDIFF = PHEP(1,K) | |
6928 | IF(GHDIFF.GE.PARMDL(175)) THEN | |
6929 | GOTO 251 | |
6930 | ELSE | |
6931 | GOTO 150 | |
6932 | ENDIF | |
6933 | ENDIF | |
6934 | 250 CONTINUE | |
6935 | WRITE(LO,'(/,1X,A)') | |
6936 | & 'PHO_GHHIOF: no diffractive entry found' | |
6937 | CALL PHO_PREVNT(-1) | |
6938 | GOTO 150 | |
6939 | 251 CONTINUE | |
6940 | C remove quasi-elastically scattered hadron | |
6941 | DO 260 K=1,NHEP | |
6942 | IF((ISTHEP(K).EQ.1).AND.(IDHEP(K).EQ.2212)) THEN | |
6943 | XF = ABS(PHEP(3,K)/EEN) | |
6944 | IF(XF.LT.PARMDL(72)) GOTO 150 | |
6945 | * ISTHEP(K) = 2 | |
6946 | GOTO 261 | |
6947 | ENDIF | |
6948 | 260 CONTINUE | |
6949 | 261 CONTINUE | |
6950 | C | |
6951 | C statistics | |
6952 | NITERS(ISIDE) = NITERS(ISIDE)+1 | |
6953 | IF(ISIDE.EQ.1) THEN | |
6954 | AY1 = AY1+Y1 | |
6955 | AYS1 = AYS1+Y1*Y1 | |
6956 | Q21AVE = Q21AVE+Q2P1 | |
6957 | Q21AV2 = Q21AV2+Q2P1*Q2P1 | |
6958 | Q21MIN = MIN(Q21MIN,Q2P1) | |
6959 | Q21MAX = MAX(Q21MAX,Q2P1) | |
6960 | YY1MIN = MIN(YY1MIN,Y1) | |
6961 | YY1MAX = MAX(YY1MAX,Y1) | |
6962 | ELSE | |
6963 | AY2 = AY2+Y2 | |
6964 | AYS2 = AYS2+Y2*Y2 | |
6965 | Q22AVE = Q22AVE+Q2P2 | |
6966 | Q22AV2 = Q22AV2+Q2P2*Q2P2 | |
6967 | Q22MIN = MIN(Q22MIN,Q2P2) | |
6968 | Q22MAX = MAX(Q22MAX,Q2P2) | |
6969 | YY2MIN = MIN(YY2MIN,Y2) | |
6970 | YY2MAX = MAX(YY2MAX,Y2) | |
6971 | ENDIF | |
6972 | C histograms | |
6973 | CALL PHO_PHIST(1,HSWGHT(0)) | |
6974 | CALL PHO_LHIST(1,HSWGHT(0)) | |
6975 | 200 CONTINUE | |
6976 | C | |
6977 | WGMAX = WGMAX1*LOG(YMAX1/YMIN1)*FAC12 | |
6978 | WGY1 = WGMAX*DBLE(ITRY)/DBLE(MAX(ITRW(1),1))*ALPHA/(2.D0*PI) | |
6979 | WGMAX = WGMAX2*LOG(YMAX2/YMIN2)*(1.D0-FAC12) | |
6980 | WGY2 = WGMAX*DBLE(ITRY)/DBLE(MAX(ITRW(2),1))*ALPHA/(2.D0*PI) | |
6981 | AY1 = AY1/DBLE(MAX(NITERS(1),1)) | |
6982 | AYS1 = AYS1/DBLE(MAX(NITERS(1),1)) | |
6983 | DAY1 = SQRT((AYS1-AY1**2)/DBLE(MAX(NITERS(1),1))) | |
6984 | AY2 = AY2/DBLE(MAX(NITERS(2),1)) | |
6985 | AYS2 = AYS2/DBLE(MAX(NITERS(2),1)) | |
6986 | DAY2 = SQRT((AYS2-AY2**2)/DBLE(MAX(NITERS(2),1))) | |
6987 | Q21AVE = Q21AVE/DBLE(MAX(NITERS(1),1)) | |
6988 | Q21AV2 = Q21AV2/DBLE(MAX(NITERS(1),1)) | |
6989 | Q21AV2 = SQRT((Q21AV2-Q21AVE**2)/DBLE(MAX(NITERS(1),1))) | |
6990 | Q22AVE = Q22AVE/DBLE(MAX(NITERS(2),1)) | |
6991 | Q22AV2 = Q22AV2/DBLE(MAX(NITERS(2),1)) | |
6992 | Q22AV2 = SQRT((Q22AV2-Q22AVE**2)/DBLE(MAX(NITERS(2),1))) | |
6993 | WGMAX = WGMAX1*LOG(YMAX1/YMIN1)+WGMAX2*LOG(YMAX2/YMIN2) | |
6994 | WGY = WGMAX*DBLE(ITRY)/DBLE(ITRW(1)+ITRW(2))*ALPHA/(2.D0*PI) | |
6995 | WEIGHT = WGY*SIGMAX*DBLE(NITER)/DBLE(ITRY) | |
6996 | C output of statistics, histograms | |
6997 | WRITE(LO,'(//1X,A,/1X,A,1PE12.3,A,/1X,A)') | |
6998 | &'=========================================================', | |
6999 | &' ***** simulated cross section: ',WEIGHT,' mb *****', | |
7000 | &'=========================================================' | |
7001 | WRITE(LO,'(//1X,A,/3X,6I12)') | |
7002 | & 'PHO_GHHIOF:SUMMARY: NITER, NITERS1/2, ITRY, ITRW1,2', | |
7003 | & NITER,NITERS,ITRY,ITRW | |
7004 | WRITE(LO,'(1X,A,1P2E12.4)') 'EFFECTIVE WEIGHT (FLUX,TOTAL)', | |
7005 | & WGY,WEIGHT | |
7006 | WRITE(LO,'(1X,A,1P2E12.4)') 'AVERAGE Y1,DY1 ', | |
7007 | & AY1,DAY1 | |
7008 | WRITE(LO,'(1X,A,1P2E12.4)') 'AVERAGE Y2,DY2 ', | |
7009 | & AY2,DAY2 | |
7010 | WRITE(LO,'(1X,A,1P2E12.4)') 'SAMPLED Y RANGE PHOTON 1 ', | |
7011 | & YY1MIN,YY1MAX | |
7012 | WRITE(LO,'(1X,A,1P2E12.4)') 'SAMPLED Y RANGE PHOTON 2 ', | |
7013 | & YY2MIN,YY2MAX | |
7014 | WRITE(LO,'(1X,A,1P2E12.4)') 'AVERAGE Q2,DQ2 PHOTON 1 ', | |
7015 | & Q21AVE,Q21AV2 | |
7016 | WRITE(LO,'(1X,A,1P2E12.4)') 'SAMPLED Q2 RANGE PHOTON 1 ', | |
7017 | & Q21MIN,Q21MAX | |
7018 | WRITE(LO,'(1X,A,1P2E12.4)') 'AVERAGE Q2,DQ2 PHOTON 2 ', | |
7019 | & Q22AVE,Q22AV2 | |
7020 | WRITE(LO,'(1X,A,1P2E12.4)') 'SAMPLED Q2 RANGE PHOTON 2 ', | |
7021 | & Q22MIN,Q22MAX | |
7022 | C | |
7023 | CALL PHO_EVENT(-2,P1,P2,WEIGHT,IREJ) | |
7024 | IF(NITER.GT.1) THEN | |
7025 | CALL PHO_PHIST(-2,WEIGHT) | |
7026 | CALL PHO_LHIST(-2,WEIGHT) | |
7027 | ELSE | |
7028 | WRITE(LO,'(1X,A,I4)') 'PHO_GHHIOF:NO OUTPUT OF HISTOGRAMS',NITER | |
7029 | ENDIF | |
7030 | ||
7031 | END | |
7032 | ||
7033 | *$ CREATE PHO_GHHIAS.FOR | |
7034 | *COPY PHO_GHHIAS | |
7035 | CDECK ID>, PHO_GHHIAS | |
7036 | SUBROUTINE PHO_GHHIAS(NEVENT,EEP,EEN,NA,NZ) | |
7037 | C********************************************************************** | |
7038 | C | |
7039 | C interface to call PHOJET (variable energy run) for | |
7040 | C gamma-hadron collisions in heavy ion - hadron | |
7041 | C collisions (form factor approach) | |
7042 | C | |
7043 | C input: EEP LAB system energy of proton (GeV) | |
7044 | C EEN LAB system energy per nucleon (GeV) | |
7045 | C NA atomic number of ion/hadron | |
7046 | C NZ charge number of ion/hadron | |
7047 | C NEVENT number of events to generate | |
7048 | C from /LEPCUT/: | |
7049 | C YMIN2 lower limit of Y | |
7050 | C (energy fraction taken by photon from hadron) | |
7051 | C YMAX2 upper cutoff for Y, necessary to avoid | |
7052 | C underflows | |
7053 | C Q2MIN2 minimum Q**2 of photons (should be set to 0) | |
7054 | C Q2MAX2 maximum Q**2 of photons (if necessary, | |
7055 | C corrected according size of hadron) | |
7056 | C | |
7057 | C********************************************************************** | |
7058 | IMPLICIT DOUBLE PRECISION (A-H,O-Z) | |
7059 | SAVE | |
7060 | ||
7061 | PARAMETER ( PI = 3.14159265359D0 ) | |
7062 | ||
7063 | C input/output channels | |
7064 | INTEGER LI,LO | |
7065 | COMMON /POINOU/ LI,LO | |
7066 | C model switches and parameters | |
7067 | CHARACTER*8 MDLNA | |
7068 | INTEGER ISWMDL,IPAMDL | |
7069 | DOUBLE PRECISION PARMDL | |
7070 | COMMON /POMDLS/ MDLNA(50),ISWMDL(50),PARMDL(400),IPAMDL(400) | |
7071 | C event debugging information | |
7072 | INTEGER NMAXD | |
7073 | PARAMETER (NMAXD=100) | |
7074 | INTEGER IDEB,KSPOM,KHPOM,KSREG,KHDIR,KACCEP,KSTRG,KHTRG,KSLOO, | |
7075 | & KHLOO,KSDPO,KHDPO,KEVENT,KSOFT,KHARD | |
7076 | COMMON /PODEBG/ IDEB(NMAXD),KSPOM,KHPOM,KSREG,KHDIR,KACCEP,KSTRG, | |
7077 | & KHTRG,KSLOO,KHLOO,KSDPO,KHDPO,KEVENT,KSOFT,KHARD | |
7078 | C photon flux kinematics and cuts | |
7079 | DOUBLE PRECISION ECMIN,ECMAX,EEMIN1,EEMIN2, | |
7080 | & YMIN1,YMAX1,YMIN2,YMAX2, | |
7081 | & Q2MIN1,Q2MAX1,Q2MIN2,Q2MAX2, | |
7082 | & THMIN1,THMAX1,THMIN2,THMAX2 | |
7083 | INTEGER ITAG1,ITAG2 | |
7084 | COMMON /POFCUT/ ECMIN,ECMAX,EEMIN1,EEMIN2, | |
7085 | & YMIN1,YMAX1,YMIN2,YMAX2, | |
7086 | & Q2MIN1,Q2MAX1,Q2MIN2,Q2MAX2, | |
7087 | & THMIN1,THMAX1,THMIN2,THMAX2, | |
7088 | & ITAG1,ITAG2 | |
7089 | C gamma-lepton or gamma-hadron vertex information | |
7090 | INTEGER IGHEL,IDPSRC,IDBSRC | |
7091 | DOUBLE PRECISION PINI,PFIN,PGAM,GYY,GQ2,GGECM,GAIMP,PFTHE,PFPHI, | |
7092 | & RADSRC,AMSRC,GAMSRC | |
7093 | COMMON /POFSRC/ PINI(5,2),PFIN(5,2),PGAM(5,2),IGHEL(2), | |
7094 | & GYY(2),GQ2(2),GGECM,GAIMP(2),PFTHE(2),PFPHI(2), | |
7095 | & IDPSRC(2),IDBSRC(2),RADSRC(2),AMSRC(2),GAMSRC(2) | |
7096 | C nucleon-nucleus / nucleus-nucleus interface to DPMJET | |
7097 | INTEGER IDEQP,IDEQB,IHFLD,IHFLS | |
7098 | DOUBLE PRECISION ECMN,PCMN,SECM,SPCM,XPSUB,XTSUB | |
7099 | COMMON /POHDFL/ ECMN,PCMN,SECM,SPCM,XPSUB,XTSUB, | |
7100 | & IDEQP(2),IDEQB(2),IHFLD(2,2),IHFLS(2) | |
7101 | C standard particle data interface | |
7102 | INTEGER NMXHEP | |
7103 | PARAMETER (NMXHEP=4000) | |
7104 | INTEGER NEVHEP,NHEP,ISTHEP,IDHEP,JMOHEP,JDAHEP | |
7105 | DOUBLE PRECISION PHEP,VHEP | |
7106 | COMMON /POEVT1/ NEVHEP,NHEP,ISTHEP(NMXHEP),IDHEP(NMXHEP), | |
7107 | & JMOHEP(2,NMXHEP),JDAHEP(2,NMXHEP),PHEP(5,NMXHEP), | |
7108 | & VHEP(4,NMXHEP) | |
7109 | C extension to standard particle data interface (PHOJET specific) | |
7110 | INTEGER IMPART,IPHIST,ICOLOR | |
7111 | COMMON /POEVT2/ IMPART(NMXHEP),IPHIST(2,NMXHEP),ICOLOR(2,NMXHEP) | |
7112 | C event weights and generated cross section | |
7113 | INTEGER IPOWGC,ISWCUT,IVWGHT | |
7114 | DOUBLE PRECISION SIGGEN,HSWGHT,HSWCUT,EVWGHT | |
7115 | COMMON /POWGHT/ SIGGEN(4),HSWGHT(0:10),HSWCUT(20),EVWGHT(0:10), | |
7116 | & IPOWGC(0:10),ISWCUT(20),IVWGHT(0:10) | |
7117 | ||
7118 | DIMENSION P1(4),P2(4) | |
7119 | ||
7120 | WRITE(LO,'(2(/1X,A))') | |
7121 | & 'PHO_GHHIAS: hadron-gamma event generation', | |
7122 | & '-----------------------------------------' | |
7123 | C hadron size and mass | |
7124 | FM2GEV = 5.07D0 | |
7125 | HIMASS = DBLE(NA)*0.938D0 | |
7126 | HIMA2 = HIMASS**2 | |
7127 | HIRADI = 1.2D0*FM2GEV*DBLE(NA)**0.333 | |
7128 | ALPHA = DBLE(NZ**2)/137.D0 | |
7129 | AMP = 0.938D0 | |
7130 | AMP2 = AMP**2 | |
7131 | C correct Q2MAX2 according to hadron size | |
7132 | Q2MAXH = 2.D0/HIRADI**2 | |
7133 | Q2MAX2 = MIN(Q2MAX2,Q2MAXH) | |
7134 | IF(Q2MAX2.LT.1.D-20) Q2MAX2 = Q2MAXH | |
7135 | C total hadron / heavy ion energy | |
7136 | EE = EEN*DBLE(NA) | |
7137 | GAMMA = EE/HIMASS | |
7138 | C setup /POFSRC/ | |
7139 | GAMSRC(2) = GAMMA | |
7140 | RADSRC(2) = HIRADI | |
7141 | AMSRC(2) = HIMASS | |
7142 | C check kinematic limitations | |
7143 | YMI = ECMIN**2/(4.D0*EE*EEP) | |
7144 | IF(YMIN2.LT.YMI) THEN | |
7145 | WRITE(LO,'(/1X,A,2E12.5)') | |
7146 | & 'PHO_GHHIOF: ymin2 increased to (old/new)',YMIN2,YMI | |
7147 | YMIN2 = YMI | |
7148 | ELSE IF(YMIN2.GT.YMI) THEN | |
7149 | WRITE(LO,'(/1X,A,/1X,A,E12.5,A,E12.5)') | |
7150 | & 'PHO_GHHIOF:','ECM-CUT CORRESPONDS TO YMIN2 OF',YMI, | |
7151 | & ' INSTEAD OF',YMIN2 | |
7152 | ENDIF | |
7153 | C kinematic limitation | |
7154 | Q2LOW2 = MAX(Q2MIN2,HIMA2*YMIN2**2/(1.D0-YMIN2)) | |
7155 | C debug output | |
7156 | WRITE(LO,'(/6X,A,2I4)') 'MASS NUMBER, CHARGE NUMBER ',NA,NZ | |
7157 | WRITE(LO,'(6X,A,E12.5)') 'HEAVY ION MASS (GeV) ',HIMASS | |
7158 | WRITE(LO,'(6X,A,E12.5)') 'HEAVY ION RADIUS (GeV**-1) ',HIRADI | |
7159 | WRITE(LO,'(6X,A,2E12.5)') 'Q**2 RANGE PHOTON 2 (GEV**2)',Q2LOW2, | |
7160 | & Q2MAX2 | |
7161 | WRITE(LO,'(6X,A,2E12.5)') 'Y RANGE PHOTON 2 ',YMIN2, | |
7162 | & YMAX2 | |
7163 | WRITE(LO,'(6X,A,2E12.5)') 'SQRT(S) PER NUCLEON, TOTAL ', | |
7164 | & 2.D0*SQRT(EEN*EEP),2.D0*SQRT(EE*EEP) | |
7165 | WRITE(LO,'(6X,A,2E12.5)') 'INV.MASS HADRON-PHOTON ',ECMIN, | |
7166 | & ECMAX | |
7167 | WRITE(LO,'(6X,A,I10)') 'EVENTS TO PROCESS ',NEVENT | |
7168 | IF(Q2LOW2.GE.Q2MAX2) THEN | |
7169 | WRITE(LO,'(/1X,A,2E12.4)') | |
7170 | & 'PHO_GHHIOF:ERROR:inconsistent Q**2 range 2',Q2LOW2,Q2MAX2 | |
7171 | CALL PHO_ABORT | |
7172 | ENDIF | |
7173 | C hadron numbers set to 0 | |
7174 | IDPSRC(1) = 0 | |
7175 | IDPSRC(2) = 0 | |
7176 | IDBSRC(1) = 0 | |
7177 | IDBSRC(2) = 0 | |
7178 | C | |
7179 | Max_tab = 100 | |
7180 | YMAX = YMAX2 | |
7181 | YMIN = YMIN2 | |
7182 | XMAX = LOG(YMAX) | |
7183 | XMIN = LOG(YMIN) | |
7184 | XDEL = XMAX-XMIN | |
7185 | DELLY = LOG(YMAX/YMIN)/DBLE(Max_tab-1) | |
7186 | DO 102 I=1,Max_tab | |
7187 | Y1 = EXP(XMIN+DELLY*DBLE(I-1)) | |
7188 | Q2LOW2 = MAX(Q2MIN2,HIMA2*Y1*Y1/(1.D0-Y1)) | |
7189 | IF(Q2LOW2.GE.Q2MAX2) THEN | |
7190 | WRITE(LO,'(/1X,A,2E12.4)') | |
7191 | & 'PHO_GHHIOF: ymax2 changed from/to',YMAX2,Y1 | |
7192 | YMAX2 = MIN(Y1,YMAX2) | |
7193 | GOTO 103 | |
7194 | ENDIF | |
7195 | 102 CONTINUE | |
7196 | 103 CONTINUE | |
7197 | C | |
7198 | X2MAX = LOG(YMAX2) | |
7199 | X2MIN = LOG(YMIN2) | |
7200 | X2DEL = X2MAX-X2MIN | |
7201 | DELLY = LOG(YMAX2/YMIN2)/DBLE(Max_tab-1) | |
7202 | FLUX = 0.D0 | |
7203 | IF(IDEB(30).GE.1) WRITE(LO,'(/1X,A,I5)') | |
7204 | & 'PHO_GHHIAS: table of raw photon flux (side 2)',Max_tab | |
7205 | DO 105 I=1,Max_tab | |
7206 | Y2 = EXP(X2MIN+DELLY*DBLE(I-1)) | |
7207 | Q2LOW2 = MAX(Q2MIN2,HIMA2*Y2*Y2/(1.D0-Y2)) | |
7208 | FF = ((1.D0+(1.D0-Y2)**2)/Y2*LOG(Q2MAX2/Q2LOW2) | |
7209 | & -2.D0*HIMA2*Y2*(1.D0/Q2LOW2-1.D0/Q2MAX2))*ALPHA/(2.D0*PI) | |
7210 | FLUX = FLUX+Y2*FF | |
7211 | IF(IDEB(30).GE.1) WRITE(LO,'(5X,2E15.4)') Y2,FF | |
7212 | 105 CONTINUE | |
7213 | FLUX = FLUX*DELLY | |
7214 | IF(IDEB(30).GE.1) WRITE(LO,'(1X,A,E12.4)') | |
7215 | & 'PHO_GHHIAS: integrated flux:',FLUX | |
7216 | C | |
7217 | C hadron | |
7218 | P1(1) = 0.D0 | |
7219 | P1(2) = 0.D0 | |
7220 | P1(3) = -SQRT(EEP**2-AMP2) | |
7221 | P1(4) = EEP | |
7222 | C photon | |
7223 | EGAM = YMAX2*EE | |
7224 | P2(1) = 0.D0 | |
7225 | P2(2) = 0.D0 | |
7226 | P2(3) = EGAM | |
7227 | P2(4) = EGAM | |
7228 | CALL PHO_SETPAR(1,2212,0,0.D0) | |
7229 | CALL PHO_SETPAR(2,22,0,0.D0) | |
7230 | CALL PHO_EVENT(-1,P1,P2,SIGMAX,IREJ) | |
7231 | C | |
7232 | Q2LOW2 = MAX(Q2MIN2,HIMA2*YMIN2**2/(1.D0-YMIN2)) | |
7233 | Y2 = YMIN2 | |
7234 | WGMAX2 = (1.D0+(1.D0-Y2)**2)*LOG(Q2MAX2/Q2LOW2) | |
7235 | & -2.D0*HIMA2*Y2*(1.D0/Q2LOW2-1.D0/Q2MAX2)*Y2 | |
7236 | C | |
7237 | CALL PHO_PHIST(-1,SIGMAX) | |
7238 | CALL PHO_LHIST(-1,SIGMAX) | |
7239 | C | |
7240 | C generation of events, flux calculation | |
7241 | AY1 = 0.D0 | |
7242 | AY2 = 0.D0 | |
7243 | AYS1 = 0.D0 | |
7244 | AYS2 = 0.D0 | |
7245 | Q22MIN = 1.D30 | |
7246 | Q22MAX = 0.D0 | |
7247 | Q22AVE = 0.D0 | |
7248 | Q22AV2 = 0.D0 | |
7249 | YY2MIN = 1.D30 | |
7250 | YY2MAX = 0.D0 | |
7251 | NITER = NEVENT | |
7252 | NITERS = 0 | |
7253 | ITRY = 0 | |
7254 | ITRW = 0 | |
7255 | DO 200 I=1,NITER | |
7256 | C sample photon flux | |
7257 | 150 CONTINUE | |
7258 | ITRY = ITRY+1 | |
7259 | 175 CONTINUE | |
7260 | C | |
7261 | ITRW = ITRW+1 | |
7262 | C select Y2 | |
7263 | Y2 = EXP(X2DEL*DT_RNDM(AY2)+X2MIN) | |
7264 | Q2LOW2 = MAX(Q2MIN2,HIMA2*Y2**2/(1.D0-Y2)) | |
7265 | IF(Q2LOW2.GE.Q2MAX2) GOTO 175 | |
7266 | Q2LOG2 = LOG(Q2MAX2/Q2LOW2) | |
7267 | WGH = (1.D0+(1.D0-Y2)**2)*Q2LOG2 | |
7268 | & -2.D0*HIMA2*Y2*(1.D0/Q2LOW2-1.D0/Q2MAX2)*Y2 | |
7269 | IF(WGMAX2.LT.WGH) WRITE(LO,'(1X,A,3E12.5)') | |
7270 | & 'PHO_GHHIOF:WEIGHT ERROR (2):',Y2,WGMAX2,WGH | |
7271 | IF(DT_RNDM(AYS1)*WGMAX2.GT.WGH) GOTO 175 | |
7272 | C sample Q2 | |
7273 | IF(IPAMDL(174).EQ.1) THEN | |
7274 | YEFF = 1.D0+(1.D0-Y2)**2 | |
7275 | 186 CONTINUE | |
7276 | Q2P2 = Q2LOW2*EXP(Q2LOG2*DT_RNDM(Y2)) | |
7277 | WEIGHT = (YEFF-2.D0*(1.D0-Y2)*Q2LOW2/Q2P2)/YEFF | |
7278 | IF(WEIGHT.LT.DT_RNDM(Q2P2)) GOTO 186 | |
7279 | ELSE | |
7280 | Q2P2 = Q2LOW2 | |
7281 | ENDIF | |
7282 | C impact parameter | |
7283 | GAIMP(2) = 1.D0/SQRT(Q2P2) | |
7284 | C form factor (squared) | |
7285 | FF2 = 1.D0 | |
7286 | IF(GAIMP(2).LT.2.D0*HIRADI) FF2 = 0.D0 | |
7287 | IF(DT_RNDM(Q2P2).GE.FF2) GOTO 175 | |
7288 | C photon data | |
7289 | GYY(2) = Y2 | |
7290 | GQ2(2) = Q2P2 | |
7291 | C | |
7292 | C incoming hadron 1 | |
7293 | PINI(1,1) = 0.D0 | |
7294 | PINI(2,1) = 0.D0 | |
7295 | PINI(3,1) = SQRT(EEP**2-AMP2) | |
7296 | PINI(4,1) = EEP | |
7297 | PINI(5,1) = AMP | |
7298 | C incoming hadron 2 | |
7299 | PINI(1,2) = 0.D0 | |
7300 | PINI(2,2) = 0.D0 | |
7301 | PINI(3,2) = -SQRT(EE**2-AMP2) | |
7302 | PINI(4,2) = EE | |
7303 | PINI(5,2) = AMP | |
7304 | C outgoing hadron 2 | |
7305 | YQ2 = SQRT((1.D0-Y2)*Q2P2) | |
7306 | Q2E = Q2P2/(4.D0*EE) | |
7307 | E1Y = EE*(1.D0-Y2) | |
7308 | CALL PHO_SFECFE(SIF,COF) | |
7309 | PFIN(1,2) = YQ2*COF | |
7310 | PFIN(2,2) = YQ2*SIF | |
7311 | PFIN(3,2) = -E1Y+Q2E | |
7312 | PFIN(4,2) = E1Y+Q2E | |
7313 | PFIN(5,2) = 0.D0 | |
7314 | PFPHI(2) = ATAN2(COF,SIF) | |
7315 | PFTHE(2) = ACOS((Q2E-E1Y)/(Q2E+E1Y)) | |
7316 | C scattering hadron | |
7317 | P1(1) = 0.D0 | |
7318 | P1(2) = 0.D0 | |
7319 | P1(3) = SQRT(EEP**2-AMP2) | |
7320 | P1(4) = EEP | |
7321 | Q2P1 = AMP2 | |
7322 | C scattering photon | |
7323 | P2(1) = -PFIN(1,2) | |
7324 | P2(2) = -PFIN(2,2) | |
7325 | P2(3) = PINI(3,2)-PFIN(3,2) | |
7326 | P2(4) = PINI(4,2)-PFIN(4,2) | |
7327 | ISIDE = 2 | |
7328 | C | |
7329 | C ECMS cut | |
7330 | GGECM = (P1(4)+P2(4))**2-(P1(1)+P2(1))**2 | |
7331 | & -(P1(2)+P2(2))**2-(P1(3)+P2(3))**2 | |
7332 | IF(GGECM.LT.0.1D0) GOTO 175 | |
7333 | GGECM = SQRT(GGECM) | |
7334 | IF((GGECM.LT.ECMIN).OR.(GGECM.GT.ECMAX)) GOTO 175 | |
7335 | C | |
7336 | PGAM(1,1) = P1(1) | |
7337 | PGAM(2,1) = P1(2) | |
7338 | PGAM(3,1) = P1(3) | |
7339 | PGAM(4,1) = P1(4) | |
7340 | PGAM(5,1) = AMP | |
7341 | PGAM(1,2) = P2(1) | |
7342 | PGAM(2,2) = P2(2) | |
7343 | PGAM(3,2) = P2(3) | |
7344 | PGAM(4,2) = P2(4) | |
7345 | PGAM(5,2) = -SQRT(Q2P2) | |
7346 | C photon helicities | |
7347 | IGHEL(2) = 1 | |
7348 | C user cuts | |
7349 | CALL PHO_PRESEL(5,IREJ) | |
7350 | IF(IREJ.NE.0) GOTO 175 | |
7351 | C event generation | |
7352 | CALL PHO_EVENT(1,P1,P2,SIGCUR,IREJ) | |
7353 | IF(IREJ.NE.0) GOTO 150 | |
7354 | C cut on diffractive mass | |
7355 | DO 250 K=1,NHEP | |
7356 | IF(ISTHEP(K).EQ.30) THEN | |
7357 | GHDIFF = PHEP(1,K) | |
7358 | IF(GHDIFF.GE.PARMDL(175)) THEN | |
7359 | GOTO 251 | |
7360 | ELSE | |
7361 | GOTO 150 | |
7362 | ENDIF | |
7363 | ENDIF | |
7364 | 250 CONTINUE | |
7365 | WRITE(LO,'(/,1X,A)') | |
7366 | & 'PHO_GHHIOF: no diffractive entry found' | |
7367 | CALL PHO_PREVNT(-1) | |
7368 | GOTO 150 | |
7369 | 251 CONTINUE | |
7370 | C remove quasi-elastically scattered hadron | |
7371 | DO 260 K=1,NHEP | |
7372 | IF((ISTHEP(K).EQ.1).AND.(IDHEP(K).EQ.2212)) THEN | |
7373 | XF = ABS(PHEP(3,K)/EEN) | |
7374 | IF(XF.LT.PARMDL(72)) GOTO 150 | |
7375 | * ISTHEP(K) = 2 | |
7376 | GOTO 261 | |
7377 | ENDIF | |
7378 | 260 CONTINUE | |
7379 | 261 CONTINUE | |
7380 | C | |
7381 | C statistics | |
7382 | NITERS = NITERS+1 | |
7383 | AY2 = AY2+Y2 | |
7384 | AYS2 = AYS2+Y2*Y2 | |
7385 | Q22AVE = Q22AVE+Q2P2 | |
7386 | Q22AV2 = Q22AV2+Q2P2*Q2P2 | |
7387 | Q22MIN = MIN(Q22MIN,Q2P2) | |
7388 | Q22MAX = MAX(Q22MAX,Q2P2) | |
7389 | YY2MIN = MIN(YY2MIN,Y2) | |
7390 | YY2MAX = MAX(YY2MAX,Y2) | |
7391 | C histograms | |
7392 | CALL PHO_PHIST(1,HSWGHT(0)) | |
7393 | CALL PHO_LHIST(1,HSWGHT(0)) | |
7394 | 200 CONTINUE | |
7395 | C | |
7396 | WGMAX = WGMAX2*LOG(YMAX2/YMIN2) | |
7397 | WGY2 = WGMAX*DBLE(ITRY)/DBLE(MAX(ITRW,1))*ALPHA/(2.D0*PI) | |
7398 | AY2 = AY2/DBLE(MAX(NITERS,1)) | |
7399 | AYS2 = AYS2/DBLE(MAX(NITERS,1)) | |
7400 | DAY2 = SQRT((AYS2-AY2**2)/DBLE(MAX(NITERS,1))) | |
7401 | Q22AVE = Q22AVE/DBLE(MAX(NITERS,1)) | |
7402 | Q22AV2 = Q22AV2/DBLE(MAX(NITERS,1)) | |
7403 | Q22AV2 = SQRT((Q22AV2-Q22AVE**2)/DBLE(MAX(NITERS,1))) | |
7404 | WGMAX = WGMAX2*LOG(YMAX2/YMIN2) | |
7405 | WGY = WGMAX*DBLE(ITRY)/DBLE(ITRW)*ALPHA/(2.D0*PI) | |
7406 | WEIGHT = WGY*SIGMAX*DBLE(NITER)/DBLE(ITRY) | |
7407 | C output of statistics, histograms | |
7408 | WRITE(LO,'(//1X,A,/1X,A,1PE12.3,A,/1X,A)') | |
7409 | &'=========================================================', | |
7410 | &' ***** simulated cross section: ',WEIGHT,' mb *****', | |
7411 | &'=========================================================' | |
7412 | WRITE(LO,'(//1X,A,/3X,4I12)') | |
7413 | & 'PHO_GHHIOF:SUMMARY: NITER, NITERS, ITRY, ITRW', | |
7414 | & NITER,NITERS,ITRY,ITRW | |
7415 | WRITE(LO,'(1X,A,1P2E12.4)') 'EFFECTIVE WEIGHT (FLUX,TOTAL)', | |
7416 | & WGY,WEIGHT | |
7417 | WRITE(LO,'(1X,A,1P2E12.4)') 'AVERAGE Y2,DY2 ', | |
7418 | & AY2,DAY2 | |
7419 | WRITE(LO,'(1X,A,1P2E12.4)') 'SAMPLED Y RANGE PHOTON 2 ', | |
7420 | & YY2MIN,YY2MAX | |
7421 | WRITE(LO,'(1X,A,1P2E12.4)') 'AVERAGE Q2,DQ2 PHOTON 2 ', | |
7422 | & Q22AVE,Q22AV2 | |
7423 | WRITE(LO,'(1X,A,1P2E12.4)') 'SAMPLED Q2 RANGE PHOTON 2 ', | |
7424 | & Q22MIN,Q22MAX | |
7425 | C | |
7426 | CALL PHO_EVENT(-2,P1,P2,WEIGHT,IREJ) | |
7427 | IF(NITER.GT.1) THEN | |
7428 | CALL PHO_PHIST(-2,WEIGHT) | |
7429 | CALL PHO_LHIST(-2,WEIGHT) | |
7430 | ELSE | |
7431 | WRITE(LO,'(1X,A,I4)') | |
7432 | & 'PHO_GHHIOF: no output of histograms',NITER | |
7433 | ENDIF | |
7434 | ||
7435 | END | |
7436 | ||
7437 | *$ CREATE PHO_FITPAR.FOR | |
7438 | *COPY PHO_FITPAR | |
7439 | CDECK ID>, PHO_FITPAR | |
7440 | SUBROUTINE PHO_FITPAR(IOUTP) | |
7441 | C********************************************************************** | |
7442 | C | |
7443 | C read input parameters according to PDFs | |
7444 | C | |
7445 | C********************************************************************** | |
7446 | IMPLICIT DOUBLE PRECISION (A-H,O-Z) | |
7447 | SAVE | |
7448 | ||
7449 | PARAMETER ( DEFA=-99999.D0, | |
7450 | & DEFB=-100000.D0, | |
7451 | & THOUS=1.D3) | |
7452 | ||
7453 | C input/output channels | |
7454 | INTEGER LI,LO | |
7455 | COMMON /POINOU/ LI,LO | |
7456 | C event debugging information | |
7457 | INTEGER NMAXD | |
7458 | PARAMETER (NMAXD=100) | |
7459 | INTEGER IDEB,KSPOM,KHPOM,KSREG,KHDIR,KACCEP,KSTRG,KHTRG,KSLOO, | |
7460 | & KHLOO,KSDPO,KHDPO,KEVENT,KSOFT,KHARD | |
7461 | COMMON /PODEBG/ IDEB(NMAXD),KSPOM,KHPOM,KSREG,KHDIR,KACCEP,KSTRG, | |
7462 | & KHTRG,KSLOO,KHLOO,KSDPO,KHDPO,KEVENT,KSOFT,KHARD | |
7463 | C model switches and parameters | |
7464 | CHARACTER*8 MDLNA | |
7465 | INTEGER ISWMDL,IPAMDL | |
7466 | DOUBLE PRECISION PARMDL | |
7467 | COMMON /POMDLS/ MDLNA(50),ISWMDL(50),PARMDL(400),IPAMDL(400) | |
7468 | C global event kinematics and particle IDs | |
7469 | INTEGER IFPAP,IFPAB | |
7470 | DOUBLE PRECISION ECM,PCM,PMASS,PVIRT | |
7471 | COMMON /POGCMS/ ECM,PCM,PMASS(2),PVIRT(2),IFPAP(2),IFPAB(2) | |
7472 | C currently activated parton density parametrizations | |
7473 | CHARACTER*8 PDFNAM | |
7474 | INTEGER IPARID,IPAVA,ITYPE,IGRP,ISET,IEXT,NPAOLD | |
7475 | DOUBLE PRECISION PDFLAM,PDFQ2M | |
7476 | COMMON /POPPDF/ PDFLAM(2),PDFQ2M(2),PDFNAM(2),IPARID(2), | |
7477 | & IPAVA(2),ITYPE(2),IGRP(2),ISET(2),IEXT(2),NPAOLD | |
7478 | C Reggeon phenomenology parameters | |
7479 | DOUBLE PRECISION ALPOM,ALPOMP,GP,B0POM,ALREG,ALREGP,GR,B0REG, | |
7480 | & GPPP,GPPR,B0PPP,B0PPR,VDMFAC,VDMQ2F,B0HAR,AKFAC | |
7481 | COMMON /POPREG/ ALPOM,ALPOMP,GP(2),B0POM(2), | |
7482 | & ALREG,ALREGP,GR(2),B0REG(2), | |
7483 | & GPPP,GPPR,B0PPP,B0PPR, | |
7484 | & VDMFAC(4),VDMQ2F(4),B0HAR,AKFAC | |
7485 | C parameters of 2x2 channel model | |
7486 | DOUBLE PRECISION PHISUP,RMASS,VAR,AMPFAC,ELAFAC,VFAC | |
7487 | COMMON /PO2CHA/ PHISUP(2),RMASS(2),VAR,AMPFAC(4),ELAFAC(4),VFAC | |
7488 | ||
7489 | DIMENSION INUM(3),IFPAS(2) | |
7490 | CHARACTER*8 CNAME8,PDFNA1,PDFNA2 | |
7491 | CHARACTER*10 CNAM10 | |
7492 | ||
7493 | PARAMETER ( Max_tab = 22 ) | |
7494 | DIMENSION XDPtab(27,Max_tab),IDPtab(8,Max_tab) | |
7495 | REAL XDPtab | |
7496 | INTEGER IDPtab | |
7497 | ||
7498 | C parameter set for 2212 (GRV94 LO) 2212 (GRV94 LO) | |
7499 | DATA (IDPtab(k, 1),k=1,8) / | |
7500 | & 2212, 5, 6, 0, 2212, 5, 6, 0 / | |
7501 | DATA (XDPtab(k, 1),k=1,27) / | |
7502 | &1.1000E+00,2.5000E-01,6.3870E+00,6.3870E+00,1.1610E+00,1.1610E+00, | |
7503 | &4.5000E-01,9.0000E-01,1.0263E+01,1.0263E+01,1.1710E+00,1.1710E+00, | |
7504 | &1.5600E-01,5.0000E-01,6.1200E-01,3.0000E-01, | |
7505 | &1.0000E+00,0.0000E+00,1.0000E+00,0.0000E+00,3.5000E+00,2.0000E+00, | |
7506 | &6.0000E-01,6.0000E-01,1.1000E+00,1.1000E+00,3.000E+00 / | |
7507 | ||
7508 | C parameter set for 2212 (GRV94 LO) -2212 (GRV94 LO) | |
7509 | DATA (IDPtab(k, 2),k=1,8) / | |
7510 | & 2212, 5, 6, 0, -2212, 5, 6, 0 / | |
7511 | DATA (XDPtab(k, 2),k=1,27) / | |
7512 | &1.1000E+00,2.5000E-01,6.3870E+00,6.3870E+00,1.1610E+00,1.1610E+00, | |
7513 | &4.5000E-01,9.0000E-01,1.5174E+01,1.5174E+01,1.5400E+00,1.5400E+00, | |
7514 | &1.5600E-01,5.0000E-01,6.1200E-01,3.0000E-01, | |
7515 | &1.0000E+00,0.0000E+00,1.0000E+00,0.0000E+00,3.5000E+00,2.0000E+00, | |
7516 | &6.0000E-01,6.0000E-01,1.1000E+00,1.1000E+00,3.000E+00 / | |
7517 | ||
7518 | C parameter set for 22 (GRV-G LO) 2212 (GRV94 LO) | |
7519 | DATA (IDPtab(k, 3),k=1,8) / | |
7520 | & 22, 5, 3, 0, 2212, 5, 6, 0 / | |
7521 | DATA (XDPtab(k, 3),k=1,27) / | |
7522 | &1.0970E+00,2.5000E-01,2.7450E+00,6.8270E+00,1.2250E+00,1.1360E+00, | |
7523 | &5.0000E-01,1.0000E+00,4.7210E+00,1.1740E+01,4.6200E-01,4.2800E-01, | |
7524 | &1.7000E-01,5.0000E-01,6.1200E-01,3.0000E-01, | |
7525 | &4.3100E-03,8.0000E-05,1.0000E+00,0.0000E+00,3.2000E+00,1.0000E+00, | |
7526 | &7.0000E-01,6.0000E-01,1.0000E+00,1.1000E+00,3.000E+00 / | |
7527 | ||
7528 | C parameter set for 22 (GRV-G LO) 22 (GRV-G LO) | |
7529 | DATA (IDPtab(k, 4),k=1,8) / | |
7530 | & 22, 5, 3, 0, 22, 5, 3, 0 / | |
7531 | DATA (XDPtab(k, 4),k=1,27) / | |
7532 | &1.0970E+00,2.5000E-01,2.7450E+00,2.7450E+00,1.2250E+00,1.2250E+00, | |
7533 | &5.0000E-01,1.0000E+00,4.7210E+00,4.7210E+00,4.6200E-01,4.6200E-01, | |
7534 | &1.7000E-01,5.0000E-01,6.1200E-01,3.0000E-01, | |
7535 | &4.3100E-03,8.0000E-05,4.3100E-03,8.0000E-05,3.2000E+00,1.0000E+00, | |
7536 | &7.0000E-01,7.0000E-01,1.0000E+00,1.0000E+00,3.000E+00 / | |
7537 | ||
7538 | C parameter set for 22 (GRS-G LO) 2212 (GRV94 LO) | |
7539 | DATA (IDPtab(k, 5),k=1,8) / | |
7540 | & 22, 5, 4, 4, 2212, 5, 6, 0 / | |
7541 | DATA (XDPtab(k, 5),k=1,27) / | |
7542 | &1.0970E+00,2.5000E-01,2.7450E+00,6.8270E+00,1.2250E+00,1.1360E+00, | |
7543 | &5.0000E-01,1.0000E+00,4.7210E+00,1.1740E+01,4.6200E-01,4.2800E-01, | |
7544 | &1.7000E-01,5.0000E-01,6.1200E-01,3.0000E-01, | |
7545 | &4.3100E-03,8.0000E-05,1.0000E+00,0.0000E+00,3.2000E+00,1.0000E+00, | |
7546 | &7.0000E-01,6.0000E-01,1.0000E+00,1.1000E+00,3.000E+00 / | |
7547 | ||
7548 | C parameter set for 22 (GRS-G LO) 22 (GRS-G LO) | |
7549 | DATA (IDPtab(k, 6),k=1,8) / | |
7550 | & 22, 5, 4, 4, 22, 5, 4, 4 / | |
7551 | DATA (XDPtab(k, 6),k=1,27) / | |
7552 | &1.0970E+00,2.5000E-01,2.7450E+00,2.7450E+00,1.2250E+00,1.2250E+00, | |
7553 | &5.0000E-01,1.0000E+00,4.7210E+00,4.7210E+00,4.6200E-01,4.6200E-01, | |
7554 | &1.7000E-01,5.0000E-01,6.1200E-01,3.0000E-01, | |
7555 | &4.3100E-03,8.0000E-05,4.3100E-03,8.0000E-05,3.2000E+00,1.0000E+00, | |
7556 | &7.0000E-01,7.0000E-01,1.0000E+00,1.0000E+00,3.000E+00 / | |
7557 | ||
7558 | C parameter set for 22 (SaS-1D ) 22 (SaS-1D ) | |
7559 | DATA (IDPtab(k, 7),k=1,8) / | |
7560 | & 22, 1, 1, 4, 22, 1, 1, 4 / | |
7561 | DATA (XDPtab(k, 7),k=1,27) / | |
7562 | &1.0970E+00,2.5000E-01,3.1170E+00,3.1170E+00,1.3450E+00,1.3450E+00, | |
7563 | &3.0200E-01,1.0000E+00,6.6050E+00,6.6050E+00,1.7500E-01,1.7500E-01, | |
7564 | &1.7000E-01,5.0000E-01,6.1200E-01,3.0000E-01, | |
7565 | &4.0900E-03,9.0000E-05,4.0900E-03,9.0000E-05,3.2000E+00,1.0000E+00, | |
7566 | &7.0000E-01,7.0000E-01,1.0000E+00,1.0000E+00,3.000E+00 / | |
7567 | ||
7568 | C parameter set for 22 (SaS-1M ) 22 (SaS-1M ) | |
7569 | DATA (IDPtab(k, 8),k=1,8) / | |
7570 | & 22, 1, 2, 4, 22, 1, 2, 4 / | |
7571 | DATA (XDPtab(k, 8),k=1,27) / | |
7572 | &1.0970E+00,2.5000E-01,2.5540E+00,2.5540E+00,1.0910E+00,1.0910E+00, | |
7573 | &5.0000E-01,1.0000E+00,4.2580E+00,4.2580E+00,4.9000E-01,4.9000E-01, | |
7574 | &1.7000E-01,5.0000E-01,6.1200E-01,3.0000E-01, | |
7575 | &4.5700E-03,1.0000E-04,4.5700E-03,1.0000E-04,3.2000E+00,1.0000E+00, | |
7576 | &7.0000E-01,7.0000E-01,1.0000E+00,1.0000E+00,3.000E+00 / | |
7577 | ||
7578 | C parameter set for 22 (SaS-2D ) 22 (SaS-2D ) | |
7579 | DATA (IDPtab(k, 9),k=1,8) / | |
7580 | & 22, 1, 3, 4, 22, 1, 3, 4 / | |
7581 | DATA (XDPtab(k, 9),k=1,27) / | |
7582 | &1.0970E+00,2.5000E-01,2.5330E+00,2.5330E+00,1.1340E+00,1.1340E+00, | |
7583 | &5.0100E-01,1.0000E+00,4.2300E+00,4.2300E+00,4.9300E-01,4.9300E-01, | |
7584 | &1.7000E-01,5.0000E-01,6.1200E-01,3.0000E-01, | |
7585 | &4.5900E-03,1.0000E-04,4.5900E-03,1.0000E-04,3.2000E+00,1.0000E+00, | |
7586 | &7.0000E-01,7.0000E-01,1.0000E+00,1.0000E+00,3.000E+00 / | |
7587 | ||
7588 | C parameter set for 22 (SaS-2M ) 22 (SaS-2M ) | |
7589 | DATA (IDPtab(k, 10),k=1,8) / | |
7590 | & 22, 1, 4, 4, 22, 1, 4, 4 / | |
7591 | DATA (XDPtab(k, 10),k=1,27) / | |
7592 | &1.0970E+00,2.5000E-01,2.8220E+00,2.8220E+00,1.0910E+00,1.0910E+00, | |
7593 | &4.9100E-01,1.0000E+00,4.6870E+00,4.6870E+00,4.5800E-01,4.5800E-01, | |
7594 | &1.7000E-01,5.0000E-01,6.1200E-01,3.0000E-01, | |
7595 | &4.6600E-03,3.0000E-05,4.6600E-03,3.0000E-05,3.2000E+00,1.0000E+00, | |
7596 | &7.0000E-01,7.0000E-01,1.0000E+00,1.0000E+00,3.000E+00 / | |
7597 | ||
7598 | C parameter set for 22 (LAC ) 2212 (GRV94 LO) | |
7599 | DATA (IDPtab(k, 11),k=1,8) / | |
7600 | & 22, 3, 1, 3, 2212, 5, 6, 0 / | |
7601 | DATA (XDPtab(k, 11),k=1,27) / | |
7602 | &1.0970E+00,2.5000E-01,3.3050E+00,6.8270E+00,9.4500E-01,1.1360E+00, | |
7603 | &4.5000E-01,1.0000E+00,6.7120E+00,1.1740E+01,2.5800E-01,4.6200E-01, | |
7604 | &1.7000E-01,5.0000E-01,6.1200E-01,3.0000E-01, | |
7605 | &3.3400E-03,2.4000E-04,1.0000E+00,0.0000E+00,2.0000E+00,1.0000E+00, | |
7606 | &7.0000E-01,6.0000E-01,1.0000E+00,1.1000E+00,3.000E+00 / | |
7607 | ||
7608 | C parameter set for 22 (PDFLIB2 ) 2212 (GRV94 LO) | |
7609 | DATA (IDPtab(k, 12),k=1,8) / | |
7610 | & 22, 3, 1, 2, 2212, 5, 6, 0 / | |
7611 | DATA (XDPtab(k, 12),k=1,27) / | |
7612 | &1.0970E+00,2.5000E-01,3.3050E+00,6.8270E+00,9.4500E-01,1.1360E+00, | |
7613 | &4.5000E-01,1.0000E+00,6.7120E+00,1.1740E+01,2.5800E-01,4.6200E-01, | |
7614 | &1.7000E-01,5.0000E-01,6.1200E-01,3.0000E-01, | |
7615 | &3.3400E-03,2.4000E-04,1.0000E+00,0.0000E+00,2.0000E+00,1.0000E+00, | |
7616 | &7.0000E-01,6.0000E-01,1.0000E+00,1.1000E+00,3.000E+00 / | |
7617 | ||
7618 | C parameter set for 22 (LAC ) 22 (LAC ) | |
7619 | DATA (IDPtab(k, 13),k=1,8) / | |
7620 | & 22, 3, 1, 3, 22, 3, 1, 3 / | |
7621 | DATA (XDPtab(k, 13),k=1,27) / | |
7622 | &1.0970E+00,2.5000E-01,3.3050E+00,3.3050E+00,9.4500E-01,9.4500E-01, | |
7623 | &4.5000E-01,1.0000E+00,6.7120E+00,6.7120E+00,2.5800E-01,2.5800E-01, | |
7624 | &1.7000E-01,5.0000E-01,6.1200E-01,3.0000E-01, | |
7625 | &3.3400E-03,2.4000E-04,3.3400E-03,2.4000E-04,2.0000E+00,1.0000E+00, | |
7626 | &7.0000E-01,7.0000E-01,1.0000E+00,1.0000E+00,3.000E+00 / | |
7627 | ||
7628 | C parameter set for 22 (PDFLIB2 ) 22 (PDFLIB2 ) | |
7629 | DATA (IDPtab(k, 14),k=1,8) / | |
7630 | & 22, 3, 1, 2, 22, 3, 1, 2 / | |
7631 | DATA (XDPtab(k, 14),k=1,27) / | |
7632 | &1.0970E+00,2.5000E-01,3.3050E+00,3.3050E+00,9.4500E-01,9.4500E-01, | |
7633 | &4.5000E-01,1.0000E+00,6.7120E+00,6.7120E+00,2.5800E-01,2.5800E-01, | |
7634 | &1.7000E-01,5.0000E-01,6.1200E-01,3.0000E-01, | |
7635 | &3.3400E-03,2.4000E-04,3.3400E-03,2.4000E-04,2.0000E+00,1.0000E+00, | |
7636 | &7.0000E-01,7.0000E-01,1.0000E+00,1.0000E+00,3.000E+00 / | |
7637 | ||
7638 | C parameter set for 22 (LAC ) 2212 (GRV94 LO) | |
7639 | DATA (IDPtab(k, 15),k=1,8) / | |
7640 | & 22, 3, 2, 3, 2212, 5, 6, 0 / | |
7641 | DATA (XDPtab(k, 15),k=1,27) / | |
7642 | &1.0970E+00,2.5000E-01,3.1450E+00,6.8270E+00,1.0490E+00,1.1360E+00, | |
7643 | &4.5000E-01,1.0000E+00,6.3680E+00,1.1740E+01,1.4700E-01,4.6200E-01, | |
7644 | &1.7000E-01,5.0000E-01,6.1200E-01,3.0000E-01, | |
7645 | &3.8700E-03,1.1000E-04,1.0000E+00,0.0000E+00,2.0000E+00,1.0000E+00, | |
7646 | &7.0000E-01,6.0000E-01,1.0000E+00,1.1000E+00,3.000E+00 / | |
7647 | ||
7648 | C parameter set for 22 (PDFLIB2 ) 2212 (GRV94 LO) | |
7649 | DATA (IDPtab(k, 16),k=1,8) / | |
7650 | & 22, 3, 2, 2, 2212, 5, 6, 0 / | |
7651 | DATA (XDPtab(k, 16),k=1,27) / | |
7652 | &1.0970E+00,2.5000E-01,3.1450E+00,6.8270E+00,1.0490E+00,1.1360E+00, | |
7653 | &4.5000E-01,1.0000E+00,6.3680E+00,1.1740E+01,1.4700E-01,4.6200E-01, | |
7654 | &1.7000E-01,5.0000E-01,6.1200E-01,3.0000E-01, | |
7655 | &3.8700E-03,1.1000E-04,1.0000E+00,0.0000E+00,2.0000E+00,1.0000E+00, | |
7656 | &7.0000E-01,6.0000E-01,1.0000E+00,1.1000E+00,3.000E+00 / | |
7657 | ||
7658 | C parameter set for 22 (LAC ) 22 (LAC ) | |
7659 | DATA (IDPtab(k, 17),k=1,8) / | |
7660 | & 22, 3, 2, 3, 22, 3, 2, 3 / | |
7661 | DATA (XDPtab(k, 17),k=1,27) / | |
7662 | &1.0970E+00,2.5000E-01,3.1450E+00,3.1450E+00,1.0490E+00,1.0490E+00, | |
7663 | &4.5000E-01,1.0000E+00,6.3680E+00,6.3680E+00,1.4700E-01,1.4700E-01, | |
7664 | &1.7000E-01,5.0000E-01,6.1200E-01,3.0000E-01, | |
7665 | &3.8700E-03,1.1000E-04,3.8700E-03,1.0000E-04,2.0000E+00,1.0000E+00, | |
7666 | &7.0000E-01,7.0000E-01,1.0000E+00,1.0000E+00,3.000E+00 / | |
7667 | ||
7668 | C parameter set for 22 (PDFLIB2 ) 22 (PDFLIB2 ) | |
7669 | DATA (IDPtab(k, 18),k=1,8) / | |
7670 | & 22, 3, 2, 2, 22, 3, 2, 2 / | |
7671 | DATA (XDPtab(k, 18),k=1,27) / | |
7672 | &1.0970E+00,2.5000E-01,3.1450E+00,3.1450E+00,1.0490E+00,1.0490E+00, | |
7673 | &4.5000E-01,1.0000E+00,6.3680E+00,6.3680E+00,1.4700E-01,1.4700E-01, | |
7674 | &1.7000E-01,5.0000E-01,6.1200E-01,3.0000E-01, | |
7675 | &3.8700E-03,1.1000E-04,3.8700E-03,1.0000E-04,2.0000E+00,1.0000E+00, | |
7676 | &7.0000E-01,7.0000E-01,1.0000E+00,1.0000E+00,3.000E+00 / | |
7677 | ||
7678 | C parameter set for 22 (LAC ) 2212 (GRV94 LO) | |
7679 | DATA (IDPtab(k, 19),k=1,8) / | |
7680 | & 22, 3, 3, 3, 2212, 5, 6, 0 / | |
7681 | DATA (XDPtab(k, 19),k=1,27) / | |
7682 | &1.0970E+00,2.5000E-01,3.0510E+00,6.8270E+00,1.0500E+00,1.1360E+00, | |
7683 | &4.5000E-01,1.0000E+00,6.0060E+00,1.1740E+01,2.0500E-01,4.6200E-01, | |
7684 | &1.7000E-01,5.0000E-01,6.1200E-01,3.0000E-01, | |
7685 | &4.0200E-03,1.0000E-04,1.0000E+00,0.0000E+00,2.0000E+00,1.0000E+00, | |
7686 | &7.0000E-01,6.0000E-01,1.0000E+00,1.1000E+00,3.000E+00 / | |
7687 | ||
7688 | C parameter set for 22 (PDFLIB2 ) 2212 (GRV94 LO) | |
7689 | DATA (IDPtab(k, 20),k=1,8) / | |
7690 | & 22, 3, 3, 2, 2212, 5, 6, 0 / | |
7691 | DATA (XDPtab(k, 20),k=1,27) / | |
7692 | &1.0970E+00,2.5000E-01,3.0510E+00,6.8270E+00,1.0500E+00,1.1360E+00, | |
7693 | &4.5000E-01,1.0000E+00,6.0060E+00,1.1740E+01,2.0500E-01,4.6200E-01, | |
7694 | &1.7000E-01,5.0000E-01,6.1200E-01,3.0000E-01, | |
7695 | &4.0200E-03,1.0000E-04,1.0000E+00,0.0000E+00,2.0000E+00,1.0000E+00, | |
7696 | &7.0000E-01,6.0000E-01,1.0000E+00,1.1000E+00,3.000E+00 / | |
7697 | ||
7698 | C parameter set for 22 (LAC ) 22 (LAC ) | |
7699 | DATA (IDPtab(k, 21),k=1,8) / | |
7700 | & 22, 3, 3, 3, 22, 3, 3, 3 / | |
7701 | DATA (XDPtab(k, 21),k=1,27) / | |
7702 | &1.0970E+00,2.5000E-01,3.0510E+00,3.0510E+00,1.0500E+00,1.0500E+00, | |
7703 | &4.5000E-01,1.0000E+00,6.0060E+00,6.0060E+00,2.0500E-01,2.0500E-01, | |
7704 | &1.7000E-01,5.0000E-01,6.1200E-01,3.0000E-01, | |
7705 | &4.0200E-03,1.0000E-04,4.0200E-03,1.0000E-04,2.0000E+00,1.0000E+00, | |
7706 | &7.0000E-01,7.0000E-01,1.0000E+00,1.0000E+00,3.000E+00 / | |
7707 | ||
7708 | C parameter set for 22 (PDFLIB2 ) 22 (PDFLIB2 ) | |
7709 | DATA (IDPtab(k, 22),k=1,8) / | |
7710 | & 22, 3, 3, 2, 22, 3, 3, 2 / | |
7711 | DATA (XDPtab(k, 22),k=1,27) / | |
7712 | &1.0970E+00,2.5000E-01,3.0510E+00,3.0510E+00,1.0500E+00,1.0500E+00, | |
7713 | &4.5000E-01,1.0000E+00,6.0060E+00,6.0060E+00,2.0500E-01,2.0500E-01, | |
7714 | &1.7000E-01,5.0000E-01,6.1200E-01,3.0000E-01, | |
7715 | &4.0200E-03,1.0000E-04,4.0200E-03,1.0000E-04,2.0000E+00,1.0000E+00, | |
7716 | &7.0000E-01,7.0000E-01,1.0000E+00,1.0000E+00,3.000E+00 / | |
7717 | ||
7718 | DATA CNAME8 /' '/ | |
7719 | DATA CNAM10 /' '/ | |
7720 | DATA INIT / 0 / | |
7721 | DATA IFPAS / 0, 0 / | |
7722 | ||
7723 | IF((INIT.EQ.1).AND. | |
7724 | & (IFPAP(1).EQ.IFPAS(1)).AND.(IFPAP(2).EQ.IFPAS(2))) GOTO 1300 | |
7725 | ||
7726 | INIT=1 | |
7727 | IFPAS(1) = IFPAP(1) | |
7728 | IFPAS(2) = IFPAP(2) | |
7729 | ||
7730 | C parton distribution functions | |
7731 | CALL PHO_ACTPDF(IFPAP(1),1) | |
7732 | CALL PHO_GETPDF(1,PDFNA1,ALAM2,Q2MIN,Q2MAX,XMIN,XMAX) | |
7733 | CALL PHO_ACTPDF(IFPAP(2),2) | |
7734 | CALL PHO_GETPDF(2,PDFNA2,ALAM2,Q2MIN,Q2MAX,XMIN,XMAX) | |
7735 | C initialize alpha_s calculation | |
7736 | DUMMY = PHO_ALPHAS(0.D0,-4) | |
7737 | ||
7738 | IF(IDEB(54).GE.0) THEN | |
7739 | WRITE(LO,'(/1X,A,I7,2X,A,3I7)') 'PHO_FITPAR: looking for PDF', | |
7740 | & IFPAP(1),PDFNA1,IGRP(1),ISET(1),IEXT(1) | |
7741 | WRITE(LO,'(1X,A,I7,2X,A,3I7)') 'PHO_FITPAR: looking for PDF', | |
7742 | & IFPAP(2),PDFNA2,IGRP(2),ISET(2),IEXT(2) | |
7743 | ENDIF | |
7744 | ||
7745 | IFOUND = 0 | |
7746 | ||
7747 | C load parameter set from internal tables | |
7748 | I1 = 1 | |
7749 | I2 = 2 | |
7750 | 110 CONTINUE | |
7751 | ||
7752 | DO I=1,Max_tab | |
7753 | IF((IFPAP(I1).EQ.IDPtab(1,I)) | |
7754 | & .AND.(IGRP(I1).EQ.IDPtab(2,I)) | |
7755 | & .AND.(ISET(I1).EQ.IDPtab(3,I)) | |
7756 | & .AND.(IEXT(I1).EQ.IDPtab(4,I))) THEN | |
7757 | IF((IFPAP(I2).EQ.IDPtab(5,I)) | |
7758 | & .AND.(IGRP(I2).EQ.IDPtab(6,I)) | |
7759 | & .AND.(ISET(I2).EQ.IDPtab(7,I)) | |
7760 | & .AND.(IEXT(I2).EQ.IDPtab(8,I))) THEN | |
7761 | WRITE(LO,'(/1X,A)') | |
7762 | & 'PHO_FITPAR: parameter set found in internal table' | |
7763 | ALPOM = XDPtab(1,I) | |
7764 | ALPOMP = XDPtab(2,I) | |
7765 | GP(I1) = XDPtab(3,I) | |
7766 | GP(I2) = XDPtab(4,I) | |
7767 | B0POM(I1) = XDPtab(5,I) | |
7768 | B0POM(I2) = XDPtab(6,I) | |
7769 | ALREG = XDPtab(7,I) | |
7770 | ALREGP = XDPtab(8,I) | |
7771 | GR(I1) = XDPtab(9,I) | |
7772 | GR(I2) = XDPtab(10,I) | |
7773 | B0REG(I1) = XDPtab(11,I) | |
7774 | B0REG(I2) = XDPtab(12,I) | |
7775 | GPPP = XDPtab(13,I) | |
7776 | B0PPP = XDPtab(14,I) | |
7777 | GPPR = XDPtab(15,I) | |
7778 | B0PPR = XDPtab(16,I) | |
7779 | VDMFAC(2*I1-1) = XDPtab(17,I) | |
7780 | VDMFAC(2*I1) = XDPtab(18,I) | |
7781 | VDMFAC(2*I2-1) = XDPtab(19,I) | |
7782 | VDMFAC(2*I2) = XDPtab(20,I) | |
7783 | B0HAR = XDPtab(21,I) | |
7784 | AKFAC = XDPtab(22,I) | |
7785 | PHISUP(I1) = XDPtab(23,I) | |
7786 | PHISUP(I2) = XDPtab(24,I) | |
7787 | RMASS(I1) = XDPtab(25,I) | |
7788 | RMASS(I2) = XDPtab(26,I) | |
7789 | VAR = XDPtab(27,I) | |
7790 | IFOUND = 1 | |
7791 | GOTO 1200 | |
7792 | ENDIF | |
7793 | ENDIF | |
7794 | ENDDO | |
7795 | ||
7796 | IF(I1.EQ.1) THEN | |
7797 | I1 = 2 | |
7798 | I2 = 1 | |
7799 | GOTO 110 | |
7800 | ELSE | |
7801 | WRITE(LO,'(/1X,A)') | |
7802 | & 'PHO_FITPAR: parameter set not found in internal table' | |
7803 | ENDIF | |
7804 | ||
7805 | 1200 CONTINUE | |
7806 | ||
7807 | C get parameters of soft cross sections from fitpar.dat | |
7808 | IF(IPAMDL(99).GT.IFOUND) THEN | |
7809 | ||
7810 | WRITE(LO,'(/1X,A)') | |
7811 | & 'PHO_FITPAR: loading parameter set from file fitpar.dat' | |
7812 | OPEN(12,FILE='fitpar.dat',ERR=1010,STATUS='OLD') | |
7813 | ||
7814 | 100 CONTINUE | |
7815 | READ(12,'(A8)',ERR=1020,END=1010) CNAME8 | |
7816 | IF(CNAME8.EQ.'STOP') GOTO 1010 | |
7817 | IF(CNAME8.EQ.'NEXTDATA') THEN | |
7818 | READ(12,'(I8,2X,A8,3I6)',ERR=1020,END=1010) | |
7819 | & IDPA1,CNAME8,INUM | |
7820 | IF((IDPA1.EQ.IFPAP(1)).AND.(CNAME8.EQ.PDFNA1) | |
7821 | & .AND.(INUM(1).EQ.IGRP(1)).AND.(INUM(2).EQ.ISET(1))) THEN | |
7822 | READ(12,'(I8,2X,A8,3I6)',ERR=1020,END=1010) | |
7823 | & IDPA2,CNAME8,INUM | |
7824 | IF((IDPA2.EQ.IFPAP(2)).AND.(CNAME8.EQ.PDFNA2).AND. | |
7825 | & (INUM(1).EQ.IGRP(2)).AND.(INUM(2).EQ.ISET(2))) THEN | |
7826 | WRITE(LO,'(/1X,A)') 'PHO_FITPAR: parameter set found' | |
7827 | READ(12,*) ALPOM,ALPOMP,GP,B0POM | |
7828 | READ(12,*) ALREG,ALREGP,GR,B0REG | |
7829 | READ(12,*) GPPP,B0PPP,GPPR,B0PPR | |
7830 | READ(12,*) VDMFAC(1),VDMFAC(2),VDMFAC(3),VDMFAC(4) | |
7831 | READ(12,*) B0HAR | |
7832 | READ(12,*) AKFAC | |
7833 | READ(12,*) PHISUP | |
7834 | READ(12,*) RMASS,VAR | |
7835 | IFOUND = 1 | |
7836 | GOTO 1100 | |
7837 | ENDIF | |
7838 | ENDIF | |
7839 | ENDIF | |
7840 | GOTO 100 | |
7841 | ||
7842 | 1020 CONTINUE | |
7843 | WRITE(LO,'(/A)') ' PHO_FITPAR: cannot read file fitpar.dat' | |
7844 | WRITE(LO,'(A,A10,A8)') ' last data card: ',CNAM10,CNAME8 | |
7845 | 1010 CONTINUE | |
7846 | WRITE(LO,'(/A)') | |
7847 | & ' PHO_FITPAR: cannot find parameter set in file fitpar.dat' | |
7848 | ||
7849 | 1100 CONTINUE | |
7850 | CLOSE(12) | |
7851 | ||
7852 | ENDIF | |
7853 | ||
7854 | C nothing found | |
7855 | IF(IFOUND.EQ.0) THEN | |
7856 | WRITE(LO,'(/A)') ' PHO_FITPAR: could not find parameter set' | |
7857 | WRITE(LO,'(3(10X,A,/))') | |
7858 | & '(copy fitpar.dat into the working directory and/or', | |
7859 | & ' request the missing parameter set via e-mail from', | |
7860 | & ' ralph.engel@fzk.de)' | |
7861 | STOP | |
7862 | ENDIF | |
7863 | ||
7864 | 1300 CONTINUE | |
7865 | ||
7866 | C overwrite parameters with user settings | |
7867 | IF(PARMDL(301).GT.DEFA) THEN | |
7868 | ALPOM = PARMDL(301) | |
7869 | PARMDL(301) = DEFB | |
7870 | ENDIF | |
7871 | IF(PARMDL(302).GT.DEFA) THEN | |
7872 | ALPOMP = PARMDL(302) | |
7873 | PARMDL(302) = DEFB | |
7874 | ENDIF | |
7875 | IF(PARMDL(303).GT.DEFA) THEN | |
7876 | GP(1) = PARMDL(303) | |
7877 | PARMDL(303) = DEFB | |
7878 | ENDIF | |
7879 | IF(PARMDL(304).GT.DEFA) THEN | |
7880 | GP(2) = PARMDL(304) | |
7881 | PARMDL(304) = DEFB | |
7882 | ENDIF | |
7883 | IF(PARMDL(305).GT.DEFA) THEN | |
7884 | B0POM(1) = PARMDL(305) | |
7885 | PARMDL(305) = DEFB | |
7886 | ENDIF | |
7887 | IF(PARMDL(306).GT.DEFA) THEN | |
7888 | B0POM(2) = PARMDL(306) | |
7889 | PARMDL(306) = DEFB | |
7890 | ENDIF | |
7891 | IF(PARMDL(307).GT.DEFA) THEN | |
7892 | ALREG = PARMDL(307) | |
7893 | PARMDL(307) = DEFB | |
7894 | ENDIF | |
7895 | IF(PARMDL(308).GT.DEFA) THEN | |
7896 | ALREGP = PARMDL(308) | |
7897 | PARMDL(308) = DEFB | |
7898 | ENDIF | |
7899 | IF(PARMDL(309).GT.DEFA) THEN | |
7900 | GR(1) = PARMDL(309) | |
7901 | PARMDL(309) = DEFB | |
7902 | ENDIF | |
7903 | IF(PARMDL(310).GT.DEFA) THEN | |
7904 | GR(2) = PARMDL(310) | |
7905 | PARMDL(310) = DEFB | |
7906 | ENDIF | |
7907 | IF(PARMDL(311).GT.DEFA) THEN | |
7908 | B0REG(1) = PARMDL(311) | |
7909 | PARMDL(311) = DEFB | |
7910 | ENDIF | |
7911 | IF(PARMDL(312).GT.DEFA) THEN | |
7912 | B0REG(2) = PARMDL(312) | |
7913 | PARMDL(312) = DEFB | |
7914 | ENDIF | |
7915 | IF(PARMDL(313).GT.DEFA) THEN | |
7916 | GPPP = PARMDL(313) | |
7917 | PARMDL(313) = DEFB | |
7918 | ENDIF | |
7919 | IF(PARMDL(314).GT.DEFA) THEN | |
7920 | B0PPP = PARMDL(314) | |
7921 | PARMDL(314)= DEFB | |
7922 | ENDIF | |
7923 | IF(PARMDL(315).GT.DEFA) THEN | |
7924 | VDMFAC(1) = PARMDL(315) | |
7925 | PARMDL(315)= DEFB | |
7926 | ENDIF | |
7927 | IF(PARMDL(316).GT.DEFA) THEN | |
7928 | VDMFAC(2) = PARMDL(316) | |
7929 | PARMDL(316)= DEFB | |
7930 | ENDIF | |
7931 | IF(PARMDL(317).GT.DEFA) THEN | |
7932 | VDMFAC(3) = PARMDL(317) | |
7933 | PARMDL(317)= DEFB | |
7934 | ENDIF | |
7935 | IF(PARMDL(318).GT.DEFA) THEN | |
7936 | VDMFAC(4) = PARMDL(318) | |
7937 | PARMDL(318)= DEFB | |
7938 | ENDIF | |
7939 | IF(PARMDL(319).GT.DEFA) THEN | |
7940 | B0HAR = PARMDL(319) | |
7941 | PARMDL(319)= DEFB | |
7942 | ENDIF | |
7943 | IF(PARMDL(320).GT.DEFA) THEN | |
7944 | AKFAC = PARMDL(320) | |
7945 | PARMDL(320)= DEFB | |
7946 | ENDIF | |
7947 | IF(PARMDL(321).GT.DEFA) THEN | |
7948 | PHISUP(1) = PARMDL(321) | |
7949 | PARMDL(321)= DEFB | |
7950 | ENDIF | |
7951 | IF(PARMDL(322).GT.DEFA) THEN | |
7952 | PHISUP(2) = PARMDL(322) | |
7953 | PARMDL(322)= DEFB | |
7954 | ENDIF | |
7955 | IF(PARMDL(323).GT.DEFA) THEN | |
7956 | RMASS(1) = PARMDL(323) | |
7957 | PARMDL(323)= DEFB | |
7958 | ENDIF | |
7959 | IF(PARMDL(324).GT.DEFA) THEN | |
7960 | RMASS(2) = PARMDL(324) | |
7961 | PARMDL(324)= DEFB | |
7962 | ENDIF | |
7963 | IF(PARMDL(325).GT.DEFA) THEN | |
7964 | VAR = PARMDL(325) | |
7965 | PARMDL(325)= DEFB | |
7966 | ENDIF | |
7967 | IF(PARMDL(327).GT.DEFA) THEN | |
7968 | GPPR = PARMDL(327) | |
7969 | PARMDL(327)= DEFB | |
7970 | ENDIF | |
7971 | IF(PARMDL(328).GT.DEFA) THEN | |
7972 | B0PPR = PARMDL(328) | |
7973 | PARMDL(328)= DEFB | |
7974 | ENDIF | |
7975 | ||
7976 | VDMQ2F(1) = VDMFAC(1) | |
7977 | VDMQ2F(2) = VDMFAC(2) | |
7978 | VDMQ2F(3) = VDMFAC(3) | |
7979 | VDMQ2F(4) = VDMFAC(4) | |
7980 | ||
7981 | C output of parameter set | |
7982 | IF((IDEB(54).GE.5).OR.(IOUTP.GT.0)) THEN | |
7983 | WRITE(LO,'(/,A,/,A)') ' PHO_FITPAR: parameter set', | |
7984 | & ' -------------------------' | |
7985 | WRITE(LO,'(2(A,F7.3),2(A,2F9.3))') | |
7986 | & ' ALPOM:',ALPOM,' ALPOMP:',ALPOMP,' GP:',GP,' B0POM:', | |
7987 | & B0POM | |
7988 | WRITE(LO,'(2(A,F7.3),2(A,2F9.3))') | |
7989 | & ' ALREG:',ALREG,' ALREGP:',ALREGP,' GR:',GR,' B0REG:', | |
7990 | & B0REG | |
7991 | WRITE(LO,'(4(A,F7.3))') | |
7992 | & ' GPPP :',GPPP,' B0PPP:',B0PPP,' GPPR :',GPPR,' B0PPR:',B0PPR | |
7993 | WRITE(LO,'(A,4F10.5)') ' VDMFAC:',VDMFAC | |
7994 | WRITE(LO,'(A,4F10.5)') ' VDMQ2F:',VDMQ2F | |
7995 | WRITE(LO,'(A,F8.3)') ' B0HAR:',B0HAR | |
7996 | WRITE(LO,'(A,F8.3)') ' AKFAC:',AKFAC | |
7997 | WRITE(LO,'(A,2F8.3)') ' PHISUP:',PHISUP | |
7998 | WRITE(LO,'(A,3F8.3)') ' RMASS:',RMASS,VAR | |
7999 | ENDIF | |
8000 | ||
8001 | CALL PHO_HARINI(1,IFPAP(1),IFPAP(2),PVIRT(1),PVIRT(2),6,IOUTP-1) | |
8002 | ||
8003 | END | |
8004 | ||
8005 | *$ CREATE PHO_BORNCS.FOR | |
8006 | *COPY PHO_BORNCS | |
8007 | CDECK ID>, PHO_BORNCS | |
8008 | SUBROUTINE PHO_BORNCS(IP,IFHARD,XM1,XM2,XM3,XM4) | |
8009 | C********************************************************************* | |
8010 | C | |
8011 | C calculation of Born graph cross sections and slopes | |
8012 | C | |
8013 | C input: IP particle combination | |
8014 | C IFHARD -1 calculate hard Born graph cross section | |
8015 | C 0 take hard Born graph cross section | |
8016 | C from interpolation table if available | |
8017 | C 1 assume that correct hard cross | |
8018 | C sections are already stored in /POSBRN/ | |
8019 | C XM1,XM2,XM3,XM4 masses of external lines | |
8020 | C /GLOCMS/ energy and PT cut-off | |
8021 | C /POPREG/ soft and hard parameters | |
8022 | C /POSBRN/ input cross sections | |
8023 | C /POZBRN/ scaled input values | |
8024 | C IFHARD 0 calculate hard input cross sections | |
8025 | C 1 assume hard input cross sections exist | |
8026 | C | |
8027 | C output: ZPOM scaled pomeron cross section | |
8028 | C ZIGR scaled reggeon cross section | |
8029 | C ZIGHR scaled hard resolved cross section | |
8030 | C ZIGHD scaled hard direct cross section | |
8031 | C ZIGT1 scaled triple-Pomeron cross section | |
8032 | C ZIGT2 scaled triple-Pomeron cross section | |
8033 | C ZIGL scaled loop-Pomeron cross section | |
8034 | C | |
8035 | C********************************************************************* | |
8036 | IMPLICIT DOUBLE PRECISION (A-H,O-Z) | |
8037 | SAVE | |
8038 | ||
8039 | PARAMETER(ITWO=2, | |
8040 | & ITHREE=3, | |
8041 | & IFOUR=4, | |
8042 | & IFIVE=5, | |
8043 | & FIVE=5.D0, | |
8044 | & THOUS=1.D3, | |
8045 | & EPS=0.01D0, | |
8046 | & DEPS=1.D-30) | |
8047 | ||
8048 | C input/output channels | |
8049 | INTEGER LI,LO | |
8050 | COMMON /POINOU/ LI,LO | |
8051 | C some constants | |
8052 | DOUBLE PRECISION PI,PI2,PI4,GEV2MB,Q_ch,Q_ch2,Q_ch4 | |
8053 | COMMON /POCONS/ PI,PI2,PI4,GEV2MB, | |
8054 | & Q_ch(-6:6),Q_ch2(-6:6),Q_ch4(-6:6) | |
8055 | C event debugging information | |
8056 | INTEGER NMAXD | |
8057 | PARAMETER (NMAXD=100) | |
8058 | INTEGER IDEB,KSPOM,KHPOM,KSREG,KHDIR,KACCEP,KSTRG,KHTRG,KSLOO, | |
8059 | & KHLOO,KSDPO,KHDPO,KEVENT,KSOFT,KHARD | |
8060 | COMMON /PODEBG/ IDEB(NMAXD),KSPOM,KHPOM,KSREG,KHDIR,KACCEP,KSTRG, | |
8061 | & KHTRG,KSLOO,KHLOO,KSDPO,KHDPO,KEVENT,KSOFT,KHARD | |
8062 | C model switches and parameters | |
8063 | CHARACTER*8 MDLNA | |
8064 | INTEGER ISWMDL,IPAMDL | |
8065 | DOUBLE PRECISION PARMDL | |
8066 | COMMON /POMDLS/ MDLNA(50),ISWMDL(50),PARMDL(400),IPAMDL(400) | |
8067 | C names of hard scattering processes | |
8068 | INTEGER Max_pro_1 | |
8069 | PARAMETER ( Max_pro_1 = 16 ) | |
8070 | CHARACTER*18 PROC | |
8071 | COMMON /POHPRO/ PROC(0:Max_pro_1) | |
8072 | C hard cross sections and MC selection weights | |
8073 | INTEGER Max_pro_2 | |
8074 | PARAMETER ( Max_pro_2 = 16 ) | |
8075 | INTEGER IHa_last,IHb_last,MH_pro_on,MH_tried, | |
8076 | & MH_acc_1,MH_acc_2 | |
8077 | DOUBLE PRECISION Hfac,HWgx,HSig,Hdpt,HEcm_last,HQ2a_last,HQ2b_last | |
8078 | COMMON /POHRCS/ Hfac(-1:Max_pro_2),HWgx(-1:Max_pro_2), | |
8079 | & HSig(-1:Max_pro_2),Hdpt(-1:Max_pro_2), | |
8080 | & HEcm_last,HQ2a_last,HQ2b_last,IHa_last,IHb_last, | |
8081 | & MH_pro_on(-1:Max_pro_2,0:4),MH_tried(-1:Max_pro_2,0:4), | |
8082 | & MH_acc_1(-1:Max_pro_2,0:4),MH_acc_2(-1:Max_pro_2,0:4) | |
8083 | C interpolation tables for hard cross section and MC selection weights | |
8084 | INTEGER Max_tab_E,Max_tab_Q2,Max_pro_tab | |
8085 | PARAMETER ( Max_tab_E = 20, Max_tab_Q2 = 10, Max_pro_tab = 16 ) | |
8086 | INTEGER IH_Q2a_up,IH_Q2b_up,IH_Ecm_up | |
8087 | DOUBLE PRECISION Hfac_tab,HWgx_tab,HSig_tab,Hdpt_tab, | |
8088 | & HQ2a_tab,HQ2b_tab,HEcm_tab | |
8089 | COMMON /POHTAB/ | |
8090 | & Hfac_tab(-1:Max_pro_tab,Max_tab_E,Max_tab_Q2,Max_tab_Q2,0:4), | |
8091 | & HWgx_tab(-1:Max_pro_tab,Max_tab_E,Max_tab_Q2,Max_tab_Q2,0:4), | |
8092 | & HSig_tab(-1:Max_pro_tab,Max_tab_E,Max_tab_Q2,Max_tab_Q2,0:4), | |
8093 | & Hdpt_tab(-1:Max_pro_tab,Max_tab_E,Max_tab_Q2,Max_tab_Q2,0:4), | |
8094 | & HQ2a_tab(1:Max_tab_Q2,0:4),HQ2b_tab(1:Max_tab_Q2,0:4), | |
8095 | & HEcm_tab(1:Max_tab_E,0:4), | |
8096 | & IH_Q2a_up(0:4),IH_Q2b_up(0:4),IH_Ecm_up(0:4) | |
8097 | C Born graph cross sections and slopes | |
8098 | INTEGER Max_pro_3 | |
8099 | PARAMETER ( Max_pro_3 = 16 ) | |
8100 | COMPLEX*16 SIGP,SIGR,SIGHD,SIGHR,SIGT1,SIGT2,SIGL,SIGDP, | |
8101 | & SIGD1,SIGD2,DSIGH | |
8102 | COMMON /POSBRN/ SIGP,SIGR,SIGHD,SIGHR,SIGT1(2),SIGT2(2),SIGL, | |
8103 | & SIGDP(4),SIGD1(2),SIGD2(2),DSIGH(0:Max_pro_3) | |
8104 | C scaled cross sections and slopes | |
8105 | COMPLEX*16 ZIGP,ZIGR,ZIGHD,ZIGHR,ZIGT1,ZIGT2,ZIGL,ZIGDP, | |
8106 | & ZIGD1,ZIGD2, | |
8107 | & BPOM,BREG,BHAR,BHAD,BTR1,BTR2,BLOO,BDP,BD1,BD2 | |
8108 | COMMON /POZBRN/ ZIGP,ZIGR,ZIGHD,ZIGHR,ZIGT1(2),ZIGT2(2),ZIGL, | |
8109 | & ZIGDP(4),ZIGD1(2),ZIGD2(2), | |
8110 | & BPOM,BREG,BHAR,BHAD,BTR1(2),BTR2(2),BLOO,BDP(4), | |
8111 | & BD1(2),BD2(2) | |
8112 | C Reggeon phenomenology parameters | |
8113 | DOUBLE PRECISION ALPOM,ALPOMP,GP,B0POM,ALREG,ALREGP,GR,B0REG, | |
8114 | & GPPP,GPPR,B0PPP,B0PPR,VDMFAC,VDMQ2F,B0HAR,AKFAC | |
8115 | COMMON /POPREG/ ALPOM,ALPOMP,GP(2),B0POM(2), | |
8116 | & ALREG,ALREGP,GR(2),B0REG(2), | |
8117 | & GPPP,GPPR,B0PPP,B0PPR, | |
8118 | & VDMFAC(4),VDMQ2F(4),B0HAR,AKFAC | |
8119 | C parameters of 2x2 channel model | |
8120 | DOUBLE PRECISION PHISUP,RMASS,VAR,AMPFAC,ELAFAC,VFAC | |
8121 | COMMON /PO2CHA/ PHISUP(2),RMASS(2),VAR,AMPFAC(4),ELAFAC(4),VFAC | |
8122 | C data of c.m. system of Pomeron / Reggeon exchange | |
8123 | INTEGER NPOSP,IDPDG1,IDBAM1,IDPDG2,IDBAM2 | |
8124 | DOUBLE PRECISION ECMP,PCMP,PMASSP,PVIRTP,GAMBEP, | |
8125 | & SIDP,CODP,SIFP,COFP | |
8126 | COMMON /POPCMS/ ECMP,PCMP,PMASSP(2),PVIRTP(2),GAMBEP(4), | |
8127 | & SIDP,CODP,SIFP,COFP,NPOSP(2), | |
8128 | & IDPDG1,IDBAM1,IDPDG2,IDBAM2 | |
8129 | C obsolete cut-off information | |
8130 | DOUBLE PRECISION PTCUT,PTANO,FPS,FPH,PSOMIN,XSOMIN | |
8131 | COMMON /POCUT1/ PTCUT(4),PTANO(4),FPS(4),FPH(4),PSOMIN,XSOMIN | |
8132 | C data needed for soft-pt calculation | |
8133 | DOUBLE PRECISION SIGS,DSIGHP,SIGH,FS,FH,BETAS,AAS,PTCON | |
8134 | COMMON /POINT3/ SIGS,DSIGHP,SIGH,FS,FH,BETAS(3),AAS,PTCON | |
8135 | ||
8136 | COMPLEX*16 CZERO,BP4,BR4,BHR4,BHD4,BT14,BT24,BD4,SP,SR,SS, | |
8137 | & BPOM1,BPOM2,BREG1,BREG2,B0HARD | |
8138 | DIMENSION SCB1(4),SCB2(4),SCG1(4),SCG2(4) | |
8139 | DIMENSION BT14(2),BT24(2),BD4(4) | |
8140 | DIMENSION DSPT(0:Max_pro_2) | |
8141 | ||
8142 | DATA XMPOM / 0.766D0 / | |
8143 | DATA CZERO /(0.D0,0.D0)/ | |
8144 | ||
8145 | CDABS(SS) = ABS(SS) | |
8146 | DCMPLX(X,Y) = CMPLX(X,Y) | |
8147 | ||
8148 | C debug output | |
8149 | IF(IDEB(48).GE.10) WRITE(LO,'(/1X,A,I3,4E12.3,I3)') | |
8150 | & 'PHO_BORNCS: IP,M1..M4,IFHARD',IP,XM1,XM2,XM3,XM4,IFHARD | |
8151 | C scales | |
8152 | CALL PHO_SCALES(XM1,XM2,XM3,XM4,SCALE1,SCALE2,SCALB1,SCALB2) | |
8153 | C | |
8154 | C calculate hard input cross sections (output in mb) | |
8155 | IF(IFHARD.NE.1) THEN | |
8156 | IF((IFHARD.EQ.0).AND.(HEcm_tab(1,IP).GT.1.D0)) THEN | |
8157 | C double-log interpolation | |
8158 | CALL PHO_HARINT(IP,ECMP,0.D0,0.D0,0,Max_pro_2,3,4,1) | |
8159 | DO 60 M=0,Max_pro_2 | |
8160 | DSIGH(M) = HSig(M) | |
8161 | DSPT(M) = Hdpt(M) | |
8162 | 60 CONTINUE | |
8163 | ELSE | |
8164 | C new calculation | |
8165 | CALL PHO_HARINT(IP,ECMP,0.D0,0.D0,0,-2,0,0,1) | |
8166 | CALL PHO_HARXTO(ECMP,PTCUT(IP),PTCUT(IP),DSIGH,DSPT) | |
8167 | ENDIF | |
8168 | C | |
8169 | C save values to calculate soft pt distribution | |
8170 | IF(IP.EQ.1) THEN | |
8171 | VDMQ2F(1) = VDMFAC(1) | |
8172 | VDMQ2F(2) = VDMFAC(2) | |
8173 | VDMQ2F(3) = VDMFAC(3) | |
8174 | VDMQ2F(4) = VDMFAC(4) | |
8175 | ELSE IF(IP.EQ.2) THEN | |
8176 | VDMQ2F(1) = VDMFAC(1) | |
8177 | VDMQ2F(2) = VDMFAC(2) | |
8178 | VDMQ2F(3) = 1.D0 | |
8179 | VDMQ2F(4) = 0.D0 | |
8180 | ELSE IF(IP.EQ.3) THEN | |
8181 | VDMQ2F(1) = VDMFAC(3) | |
8182 | VDMQ2F(2) = VDMFAC(4) | |
8183 | VDMQ2F(3) = 1.D0 | |
8184 | VDMQ2F(4) = 0.D0 | |
8185 | ELSE | |
8186 | VDMQ2F(1) = 1.D0 | |
8187 | VDMQ2F(2) = 0.D0 | |
8188 | VDMQ2F(3) = 1.D0 | |
8189 | VDMQ2F(4) = 0.D0 | |
8190 | ENDIF | |
8191 | C VDM factors | |
8192 | AMPFAC(1) = SQRT(VDMQ2F(1)*VDMQ2F(3)) | |
8193 | AMPFAC(2) = SQRT(VDMQ2F(2)*VDMQ2F(3)) | |
8194 | AMPFAC(3) = SQRT(VDMQ2F(1)*VDMQ2F(4)) | |
8195 | AMPFAC(4) = SQRT(VDMQ2F(2)*VDMQ2F(4)) | |
8196 | ELAFAC(1) = VDMQ2F(1)*VDMQ2F(3)+VDMQ2F(2)*VDMQ2F(3) | |
8197 | & +VDMQ2F(1)*VDMQ2F(4)+VDMQ2F(2)*VDMQ2F(4) | |
8198 | ELAFAC(2) = 2.D0*(AMPFAC(1)*AMPFAC(2)+AMPFAC(3)*AMPFAC(4)) | |
8199 | ELAFAC(3) = 2.D0*(AMPFAC(1)*AMPFAC(3)+AMPFAC(2)*AMPFAC(4)) | |
8200 | ELAFAC(4) = 4.D0*AMPFAC(1)*AMPFAC(4) | |
8201 | VFAC = ELAFAC(1)+PHISUP(1)*PHISUP(2)*ELAFAC(4) | |
8202 | & +PHISUP(1)*ELAFAC(2)+PHISUP(2)*ELAFAC(3) | |
8203 | DSIGHP = DSPT(9)/VFAC | |
8204 | SIGH = DSIGH(9)/VFAC | |
8205 | C extract real part | |
8206 | IF(IPAMDL(1).EQ.0) THEN | |
8207 | DO 50 I=0,Max_pro_2 | |
8208 | DSIGH(I)=DCMPLX(DREAL(DSIGH(I)),0.D0) | |
8209 | 50 CONTINUE | |
8210 | ENDIF | |
8211 | C write out results | |
8212 | IF(IDEB(48).GE.15) THEN | |
8213 | WRITE(LO,'(/1X,A,1P,2E11.3)') | |
8214 | & 'PHO_BORNCS: QCD-PM cross sections (mb)',ECMP,PTCUT(IP) | |
8215 | DO 200 I=0,Max_pro_2 | |
8216 | WRITE(LO,'(10X,A,2E14.4)') PROC(I),DSIGH(I) | |
8217 | 200 CONTINUE | |
8218 | ENDIF | |
8219 | ENDIF | |
8220 | ||
8221 | C DPMJET interface: subtract anomalous part | |
8222 | IF((IP.EQ.1).AND.(IPAMDL(13).GT.0)) | |
8223 | & DSIGH(9) = DSIGH(9)-DCMPLX(DT_SANO(ECMP),0.D0) | |
8224 | ||
8225 | SCALE = CDABS(DSIGH(15)) | |
8226 | IF(SCALE.LT.DEPS) THEN | |
8227 | SIGHD=CZERO | |
8228 | ELSE | |
8229 | SIGHD=DSIGH(15) | |
8230 | ENDIF | |
8231 | SCALE = CDABS(DSIGH(9)) | |
8232 | IF(SCALE.LT.DEPS) THEN | |
8233 | SIGHR=CZERO | |
8234 | ELSE | |
8235 | SIGHR=DSIGH(9)*SCALE1*SCALE2/VFAC | |
8236 | ENDIF | |
8237 | ||
8238 | C calculate soft input cross sections (output in mb) | |
8239 | SS=DCMPLX(ECMP**2-PMASSP(1)**2-PMASSP(2)**2+0.01D0,0.D0) | |
8240 | IF(IPAMDL(1).EQ.1) THEN | |
8241 | C pomeron signature | |
8242 | SP=SS*DCMPLX(0.D0,-1.D0) | |
8243 | C reggeon signature | |
8244 | SR=SS*DCMPLX(0.D0,1.D0) | |
8245 | ELSE | |
8246 | SP=SS | |
8247 | SR=SS | |
8248 | ENDIF | |
8249 | C coupling constants (mb**1/2) | |
8250 | C particle dependent slopes (GeV**-2) | |
8251 | IF(IP.EQ.1) THEN | |
8252 | GP1 = GP(1) | |
8253 | GP2 = GP(2) | |
8254 | GR1 = GR(1) | |
8255 | GR2 = GR(2) | |
8256 | B0POM1 = B0POM(1) | |
8257 | B0POM2 = B0POM(2) | |
8258 | B0REG1 = B0REG(1) | |
8259 | B0REG2 = B0REG(2) | |
8260 | B0HARD = B0HAR | |
8261 | RMASS1 = RMASS(1) | |
8262 | RMASS2 = RMASS(2) | |
8263 | ELSE IF(IP.EQ.2) THEN | |
8264 | GP1 = GP(1) | |
8265 | GP2 = PARMDL(77) | |
8266 | GR1 = GR(1) | |
8267 | GR2 = PARMDL(77)*GPPR/GPPP | |
8268 | B0POM1 = B0POM(1) | |
8269 | B0POM2 = B0PPP | |
8270 | B0REG1 = B0REG(1) | |
8271 | B0REG2 = B0PPR | |
8272 | B0HARD = B0POM1+B0POM2 | |
8273 | RMASS1 = RMASS(1) | |
8274 | RMASS2 = XMPOM | |
8275 | ELSE IF(IP.EQ.3) THEN | |
8276 | GP1 = GP(2) | |
8277 | GP2 = PARMDL(77) | |
8278 | GR1 = GR(2) | |
8279 | GR2 = PARMDL(77)*GPPR/GPPP | |
8280 | B0POM1 = B0POM(2) | |
8281 | B0POM2 = B0PPP | |
8282 | B0REG1 = B0REG(2) | |
8283 | B0REG2 = B0PPR | |
8284 | B0HARD = B0POM1+B0POM2 | |
8285 | RMASS1 = RMASS(2) | |
8286 | RMASS2 = XMPOM | |
8287 | ELSE IF(IP.EQ.4) THEN | |
8288 | GP1 = PARMDL(77) | |
8289 | GP2 = GP1 | |
8290 | GR1 = PARMDL(77)*GPPR/GPPP | |
8291 | GR2 = GR1 | |
8292 | B0POM1 = B0PPP | |
8293 | B0POM2 = B0PPP | |
8294 | B0REG1 = B0PPR | |
8295 | B0REG2 = B0PPR | |
8296 | B0HARD = B0POM1+B0POM2 | |
8297 | RMASS1 = XMPOM | |
8298 | RMASS2 = XMPOM | |
8299 | ELSE | |
8300 | WRITE(LO,'(/1X,A,I7)') 'PHO_BORNCS:ERROR:invalid IP',IP | |
8301 | CALL PHO_ABORT | |
8302 | ENDIF | |
8303 | GP1 = GP1*SCALE1 | |
8304 | GP2 = GP2*SCALE2 | |
8305 | GR1 = GR1*SCALE1 | |
8306 | GR2 = GR2*SCALE2 | |
8307 | C input slope parameters (GeV**-2) | |
8308 | BPOM1 = B0POM1*SCALB1 | |
8309 | BPOM2 = B0POM2*SCALB2 | |
8310 | BREG1 = B0REG1*SCALB1 | |
8311 | BREG2 = B0REG2*SCALB2 | |
8312 | C effective slopes | |
8313 | XMR2 = (2.D0*MIN(XM1,XM3)*MIN(XM2,XM4))**2 | |
8314 | SCALE = SS*XMR2/((XM1**2+XM3**2)*(XM2**2+XM4**2))+2.D0 | |
8315 | BPOM = BPOM1 + BPOM2 + ALPOMP*LOG(SCALE) | |
8316 | BREG = BREG1 + BREG2 + ALREGP*LOG(SCALE) | |
8317 | IF(IPAMDL(9).EQ.0) THEN | |
8318 | BHAR = B0HARD | |
8319 | BHAD = B0HARD | |
8320 | ELSE IF(IPAMDL(9).EQ.1) THEN | |
8321 | BHAR = B0HARD*(SCALB1+SCALB2)/2.D0 | |
8322 | BHAD = BHAR | |
8323 | ELSE IF(IPAMDL(9).EQ.2) THEN | |
8324 | BHAR = BPOM1+BPOM2 | |
8325 | BHAD = BHAR | |
8326 | ELSE | |
8327 | BHAR = BPOM | |
8328 | BHAD = BPOM | |
8329 | ENDIF | |
8330 | C input cross section pomeron | |
8331 | SIGP=GP1*GP2*EXP((ALPOM-1.D0)*LOG(SP)) | |
8332 | SIGR=GR1*GR2*EXP((ALREG-1.D0)*LOG(SR)) | |
8333 | C save value to calculate soft pt distribution | |
8334 | SIGS = (SIGR+SIGP)/(SCALE1*SCALE2) | |
8335 | ||
8336 | C higher order graphs | |
8337 | VIRT1 = PVIRTP(1) | |
8338 | VIRT2 = PVIRTP(2) | |
8339 | C bare/renormalized intercept for enhanced graphs | |
8340 | IF(IPAMDL(8).EQ.0) THEN | |
8341 | DELTAP = ALPOM-1.D0 | |
8342 | ELSE | |
8343 | DELTAP = PARMDL(48)-1.D0 | |
8344 | ENDIF | |
8345 | SD = ECMP**2 | |
8346 | BP1 = 2.D0*BPOM1 | |
8347 | BP2 = 2.D0*BPOM2 | |
8348 | C input cross section high-mass double diffraction | |
8349 | CALL PHO_LOOREG(SD,GP1,BP1,GP2,BP2, | |
8350 | & DELTAP,ALPOMP,GPPP,B0PPP,VIRT1,VIRT2,SIGTR,BTR) | |
8351 | SIGL = DCMPLX(SIGTR,0.D0) | |
8352 | BLOO = DCMPLX(BTR,0.D0) | |
8353 | C | |
8354 | C input cross section high mass diffraction particle 1 | |
8355 | C first possibility | |
8356 | CALL PHO_SCALES(XM1,XM2,XM3,PMASSP(2), | |
8357 | & SCG1(1),SCG2(1),SCB1(1),SCB2(1)) | |
8358 | CALL PHO_SCALES(XM1,PMASSP(2),XM3,XM4, | |
8359 | & SCG1(2),SCG2(2),SCB1(2),SCB2(2)) | |
8360 | SCALB1 = (SCB1(1)+SCB1(2))/2.D0 | |
8361 | SCALB2 = (SCB2(1)+SCB2(2))/2.D0 | |
8362 | BP1 = 2.D0*BPOM1*SCALB1 | |
8363 | BP2 = 2.D0*BPOM2*SCALB2 | |
8364 | C input cross section high mass diffraction | |
8365 | CALL PHO_TRIREG(SD,GP1,BP1,GP2,BP2, | |
8366 | & DELTAP,ALPOMP,GPPP,B0PPP,VIRT1,SIGTR,BTR) | |
8367 | SIGT1(1) = SCG1(1)*SCG2(1)*SCG2(2)*DCMPLX(SIGTR,0.D0) | |
8368 | BTR1(1) = DCMPLX(BTR,0.D0) | |
8369 | C second possibility: high-low mass double diffraction | |
8370 | CALL PHO_SCALES(XM1,XM2,XM3,RMASS2, | |
8371 | & SCG1(1),SCG2(1),SCB1(1),SCB2(1)) | |
8372 | CALL PHO_SCALES(XM1,RMASS2,XM3,XM4, | |
8373 | & SCG1(2),SCG2(2),SCB1(2),SCB2(2)) | |
8374 | SCALB1 = (SCB1(1)+SCB1(2))/2.D0 | |
8375 | SCALB2 = (SCB2(1)+SCB2(2))/2.D0 | |
8376 | BP1 = 2.D0*BPOM1*SCALB1 | |
8377 | BP2 = 2.D0*BPOM2*SCALB2 | |
8378 | C input cross section high mass diffraction | |
8379 | CALL PHO_TRIREG(SD,GP1,BP1,GP2,BP2, | |
8380 | & DELTAP,ALPOMP,GPPP,B0PPP,VIRT1,SIGTR,BTR) | |
8381 | SIGT1(2) = SCG1(1)*SCG2(1)*SCG2(2)*DCMPLX(SIGTR,0.D0) | |
8382 | BTR1(2) = DCMPLX(BTR,0.D0) | |
8383 | C | |
8384 | C input cross section high mass diffraction particle 2 | |
8385 | C first possibility | |
8386 | CALL PHO_SCALES(XM1,XM2,PMASSP(1),XM4, | |
8387 | & SCG1(1),SCG2(1),SCB1(1),SCB2(1)) | |
8388 | CALL PHO_SCALES(PMASSP(1),XM2,XM3,XM4, | |
8389 | & SCG1(2),SCG2(2),SCB1(2),SCB2(2)) | |
8390 | SCALB1 = (SCB1(1)+SCB1(2))/2.D0 | |
8391 | SCALB2 = (SCB2(1)+SCB2(2))/2.D0 | |
8392 | BP1 = 2.D0*BPOM1*SCALB1 | |
8393 | BP2 = 2.D0*BPOM2*SCALB2 | |
8394 | C input cross section high mass diffraction | |
8395 | CALL PHO_TRIREG(SD,GP2,BP2,GP1,BP1, | |
8396 | & DELTAP,ALPOMP,GPPP,B0PPP,VIRT2,SIGTR,BTR) | |
8397 | SIGT2(1) = SCG1(1)*SCG1(2)*SCG2(1)*DCMPLX(SIGTR,0.D0) | |
8398 | BTR2(1) = DCMPLX(BTR,0.D0) | |
8399 | C second possibility: high-low mass double diffraction | |
8400 | CALL PHO_SCALES(XM1,XM2,RMASS1,XM4, | |
8401 | & SCG1(1),SCG2(1),SCB1(1),SCB2(1)) | |
8402 | CALL PHO_SCALES(RMASS1,XM2,XM3,XM4, | |
8403 | & SCG1(2),SCG2(2),SCB1(2),SCB2(2)) | |
8404 | SCALB1 = (SCB1(1)+SCB1(2))/2.D0 | |
8405 | SCALB2 = (SCB2(1)+SCB2(2))/2.D0 | |
8406 | BP1 = 2.D0*BPOM1*SCALB1 | |
8407 | BP2 = 2.D0*BPOM2*SCALB2 | |
8408 | C input cross section high mass diffraction | |
8409 | CALL PHO_TRIREG(SD,GP2,BP2,GP1,BP1, | |
8410 | & DELTAP,ALPOMP,GPPP,B0PPP,VIRT2,SIGTR,BTR) | |
8411 | SIGT2(2) = SCG1(1)*SCG1(2)*SCG2(1)*DCMPLX(SIGTR,0.D0) | |
8412 | BTR2(2) = DCMPLX(BTR,0.D0) | |
8413 | C | |
8414 | C input cross section for loop-pomeron | |
8415 | C first possibility | |
8416 | CALL PHO_SCALES(XM1,XM2,PMASSP(1),XM4, | |
8417 | & SCG1(1),SCG2(1),SCB1(1),SCB2(1)) | |
8418 | CALL PHO_SCALES(PMASSP(1),XM2,XM3,XM4, | |
8419 | & SCG1(2),SCG2(2),SCB1(2),SCB2(2)) | |
8420 | CALL PHO_SCALES(XM1,XM2,XM3,PMASSP(2), | |
8421 | & SCG1(3),SCG2(3),SCB1(3),SCB2(3)) | |
8422 | CALL PHO_SCALES(XM1,PMASSP(2),XM3,XM4, | |
8423 | & SCG1(4),SCG2(4),SCB1(4),SCB2(4)) | |
8424 | SCALB1 = (SCB1(1)+SCB1(2)+SCB1(3)+SCB1(4))/4.D0 | |
8425 | SCALB2 = (SCB2(1)+SCB2(2)+SCB2(3)+SCB2(4))/4.D0 | |
8426 | BP1 = BPOM1*SCALB1 | |
8427 | BP2 = BPOM2*SCALB2 | |
8428 | CALL PHO_TRXPOM(SD,GP2,BP2,GP1,BP1,DELTAP,ALPOMP,GPPP,B0PPP, | |
8429 | & SIGTX,BTX) | |
8430 | SIGDP(1) = SCG1(1)*SCG1(2)*SCG2(3)*SCG2(4)*DCMPLX(SIGTX,0.D0) | |
8431 | BDP(1) = DCMPLX(BTX,0.D0) | |
8432 | C second possibility | |
8433 | CALL PHO_SCALES(XM1,XM2,RMASS1,XM4, | |
8434 | & SCG1(1),SCG2(1),SCB1(1),SCB2(1)) | |
8435 | CALL PHO_SCALES(RMASS1,XM2,XM3,XM4, | |
8436 | & SCG1(2),SCG2(2),SCB1(2),SCB2(2)) | |
8437 | CALL PHO_SCALES(XM1,XM2,XM3,PMASSP(2), | |
8438 | & SCG1(3),SCG2(3),SCB1(3),SCB2(3)) | |
8439 | CALL PHO_SCALES(XM1,PMASSP(2),XM3,XM4, | |
8440 | & SCG1(4),SCG2(4),SCB1(4),SCB2(4)) | |
8441 | SCALB1 = (SCB1(1)+SCB1(2)+SCB1(3)+SCB1(4))/4.D0 | |
8442 | SCALB2 = (SCB2(1)+SCB2(2)+SCB2(3)+SCB2(4))/4.D0 | |
8443 | BP1 = BPOM1*SCALB1 | |
8444 | BP2 = BPOM2*SCALB2 | |
8445 | CALL PHO_TRXPOM(SD,GP2,BP2,GP1,BP1,DELTAP,ALPOMP,GPPP,B0PPP, | |
8446 | & SIGTX,BTX) | |
8447 | SIGDP(2) = SCG1(1)*SCG1(2)*SCG2(3)*SCG2(4)*DCMPLX(SIGTX,0.D0) | |
8448 | BDP(2) = DCMPLX(BTX,0.D0) | |
8449 | C third possibility | |
8450 | CALL PHO_SCALES(XM1,XM2,PMASSP(1),XM4, | |
8451 | & SCG1(1),SCG2(1),SCB1(1),SCB2(1)) | |
8452 | CALL PHO_SCALES(PMASSP(1),XM2,XM3,XM4, | |
8453 | & SCG1(2),SCG2(2),SCB1(2),SCB2(2)) | |
8454 | CALL PHO_SCALES(XM1,XM2,XM3,RMASS2, | |
8455 | & SCG1(3),SCG2(3),SCB1(3),SCB2(3)) | |
8456 | CALL PHO_SCALES(XM1,RMASS2,XM3,XM4, | |
8457 | & SCG1(4),SCG2(4),SCB1(4),SCB2(4)) | |
8458 | SCALB1 = (SCB1(1)+SCB1(2)+SCB1(3)+SCB1(4))/4.D0 | |
8459 | SCALB2 = (SCB2(1)+SCB2(2)+SCB2(3)+SCB2(4))/4.D0 | |
8460 | BP1 = BPOM1*SCALB1 | |
8461 | BP2 = BPOM2*SCALB2 | |
8462 | CALL PHO_TRXPOM(SD,GP2,BP2,GP1,BP1,DELTAP,ALPOMP,GPPP,B0PPP, | |
8463 | & SIGTX,BTX) | |
8464 | SIGDP(3) = SCG1(1)*SCG1(2)*SCG2(3)*SCG2(4)*DCMPLX(SIGTX,0.D0) | |
8465 | BDP(3) = DCMPLX(BTX,0.D0) | |
8466 | C fourth possibility | |
8467 | CALL PHO_SCALES(XM1,XM2,RMASS1,XM4, | |
8468 | & SCG1(1),SCG2(1),SCB1(1),SCB2(1)) | |
8469 | CALL PHO_SCALES(RMASS1,XM2,XM3,XM4, | |
8470 | & SCG1(2),SCG2(2),SCB1(2),SCB2(2)) | |
8471 | CALL PHO_SCALES(XM1,XM2,XM3,RMASS2, | |
8472 | & SCG1(3),SCG2(3),SCB1(3),SCB2(3)) | |
8473 | CALL PHO_SCALES(XM1,RMASS2,XM3,XM4, | |
8474 | & SCG1(4),SCG2(4),SCB1(4),SCB2(4)) | |
8475 | SCALB1 = (SCB1(1)+SCB1(2)+SCB1(3)+SCB1(4))/4.D0 | |
8476 | SCALB2 = (SCB2(1)+SCB2(2)+SCB2(3)+SCB2(4))/4.D0 | |
8477 | BP1 = BPOM1*SCALB1 | |
8478 | BP2 = BPOM2*SCALB2 | |
8479 | CALL PHO_TRXPOM(SD,GP2,BP2,GP1,BP1,DELTAP,ALPOMP,GPPP,B0PPP, | |
8480 | & SIGTX,BTX) | |
8481 | SIGDP(4) = SCG1(1)*SCG1(2)*SCG2(3)*SCG2(4)*DCMPLX(SIGTX,0.D0) | |
8482 | BDP(4) = DCMPLX(BTX,0.D0) | |
8483 | C | |
8484 | C input cross section for YY-iterated triple-pomeron | |
8485 | C ..... | |
8486 | C | |
8487 | C write out input cross sections | |
8488 | IF(IDEB(48).GE.5) THEN | |
8489 | WRITE(LO,'(2(/1X,A))') | |
8490 | & 'Born graph input cross sections and slopes', | |
8491 | & '------------------------------------------' | |
8492 | WRITE(LO,'(1X,A,3E12.3)') 'energy ',ECMP,PVIRTP | |
8493 | WRITE(LO,'(1X,A,4E12.3)') 'external masses 1,2,3,4 ', | |
8494 | & XM1,XM2,XM3,XM4 | |
8495 | WRITE(LO,'(A)') ' input cross sections (millibarn):' | |
8496 | WRITE(LO,'(A,2E12.3)') ' SIGR ',SIGR | |
8497 | WRITE(LO,'(A,2E12.3)') ' (soft) SIGP ',SIGP | |
8498 | WRITE(LO,'(A,2E12.3)') ' (hard) SIGHR ',SIGHR | |
8499 | WRITE(LO,'(A,2E12.3)') ' SIGHD ',SIGHD | |
8500 | WRITE(LO,'(A,4E12.3)') ' SIGT1 ',SIGT1 | |
8501 | WRITE(LO,'(A,4E12.3)') ' SIGT2 ',SIGT2 | |
8502 | WRITE(LO,'(A,2E12.3)') ' SIGL ',SIGL | |
8503 | WRITE(LO,'(A,4E12.3)') ' SIGDP(1-2) ',SIGDP(1),SIGDP(2) | |
8504 | WRITE(LO,'(A,4E12.3)') ' SIGDP(3-4) ',SIGDP(3),SIGDP(4) | |
8505 | WRITE(LO,'(A)') ' input slopes (GeV**-2)' | |
8506 | WRITE(LO,'(A,2E12.3)') ' BREG ',BREG | |
8507 | WRITE(LO,'(A,2E12.3)') ' BREG1 ',BREG1 | |
8508 | WRITE(LO,'(A,2E12.3)') ' BREG2 ',BREG2 | |
8509 | WRITE(LO,'(A,2E12.3)') ' BPOM ',BPOM | |
8510 | WRITE(LO,'(A,2E12.3)') ' BPOM1 ',BPOM1 | |
8511 | WRITE(LO,'(A,2E12.3)') ' BPOM2 ',BPOM2 | |
8512 | WRITE(LO,'(A,2E12.3)') ' BHAR ',BHAR | |
8513 | WRITE(LO,'(A,2E12.3)') ' BHAD ',BHAD | |
8514 | WRITE(LO,'(A,E12.3)') ' B0PPP ',B0PPP | |
8515 | WRITE(LO,'(A,4E12.3)') ' BTR1 ',BTR1 | |
8516 | WRITE(LO,'(A,4E12.3)') ' BTR2 ',BTR2 | |
8517 | WRITE(LO,'(A,2E12.3)') ' BLOO ',BLOO | |
8518 | WRITE(LO,'(A,4E12.3)') ' BDP(1-2) ',BDP(1),BDP(2) | |
8519 | WRITE(LO,'(A,4E12.3)') ' BDP(3-4) ',BDP(3),BDP(4) | |
8520 | ENDIF | |
8521 | C | |
8522 | BPOM = BPOM*GEV2MB | |
8523 | BREG = BREG*GEV2MB | |
8524 | BHAR = BHAR*GEV2MB | |
8525 | BHAD = BHAD*GEV2MB | |
8526 | BTR1(1) = BTR1(1)*GEV2MB | |
8527 | BTR1(2) = BTR1(2)*GEV2MB | |
8528 | BTR2(1) = BTR2(1)*GEV2MB | |
8529 | BTR2(2) = BTR2(2)*GEV2MB | |
8530 | BLOO = BLOO*GEV2MB | |
8531 | C | |
8532 | BP4 =BPOM*4.D0 | |
8533 | BR4 =BREG*4.D0 | |
8534 | BHR4=BHAR*4.D0 | |
8535 | BHD4=BHAD*4.D0 | |
8536 | BT14(1)=BTR1(1)*4.D0 | |
8537 | BT14(2)=BTR1(2)*4.D0 | |
8538 | BT24(1)=BTR2(1)*4.D0 | |
8539 | BT24(2)=BTR2(2)*4.D0 | |
8540 | BL4 =BLOO*4.D0 | |
8541 | C | |
8542 | ZIGP = SIGP/(PI2*BP4) | |
8543 | ZIGR = SIGR/(PI2*BR4) | |
8544 | ZIGHR = SIGHR/(PI2*BHR4) | |
8545 | ZIGHD = SIGHD/(PI2*BHD4) | |
8546 | ZIGT1(1) = SIGT1(1)/(PI2*BT14(1)) | |
8547 | ZIGT1(2) = SIGT1(2)/(PI2*BT14(2)) | |
8548 | ZIGT2(1) = SIGT2(1)/(PI2*BT24(1)) | |
8549 | ZIGT2(2) = SIGT2(2)/(PI2*BT24(2)) | |
8550 | ZIGL = SIGL/(PI2*BL4) | |
8551 | DO 20 I=1,4 | |
8552 | BDP(I) = BDP(I)*GEV2MB | |
8553 | BD4(I) = BDP(I)*4.D0 | |
8554 | ZIGDP(I) = SIGDP(I)/(PI2*BD4(I)) | |
8555 | 20 CONTINUE | |
8556 | C | |
8557 | IF(IDEB(48).GE.10) THEN | |
8558 | WRITE(LO,'(A)') ' normalized input values:' | |
8559 | WRITE(LO,'(A,2E12.3)') ' ZIGR ',ZIGR | |
8560 | WRITE(LO,'(A,2E12.3)') ' BREG ',BREG | |
8561 | WRITE(LO,'(A,2E12.3)') ' ZIGP ',ZIGP | |
8562 | WRITE(LO,'(A,2E12.3)') ' BPOM ',BPOM | |
8563 | WRITE(LO,'(A,2E12.3)') ' ZIGHR ',ZIGHR | |
8564 | WRITE(LO,'(A,2E12.3)') ' BHAR ',BHAR | |
8565 | WRITE(LO,'(A,2E12.3)') ' ZIGHD ',ZIGHD | |
8566 | WRITE(LO,'(A,2E12.3)') ' BHAD ',BHAD | |
8567 | WRITE(LO,'(A,4E12.3)') ' ZIGT1 ',ZIGT1 | |
8568 | WRITE(LO,'(A,4E12.3)') ' ZIGT2 ',ZIGT2 | |
8569 | WRITE(LO,'(A,2E12.3)') ' ZIGL ',ZIGL | |
8570 | WRITE(LO,'(A,4E12.3)') ' ZIGDP(1-2) ',ZIGDP(1),ZIGDP(2) | |
8571 | WRITE(LO,'(A,4E12.3)') ' ZIGDP(3-4) ',ZIGDP(3),ZIGDP(4) | |
8572 | ENDIF | |
8573 | END | |
8574 | ||
8575 | *$ CREATE PHO_SCALES.FOR | |
8576 | *COPY PHO_SCALES | |
8577 | CDECK ID>, PHO_SCALES | |
8578 | SUBROUTINE PHO_SCALES(XM1,XM2,XM3,XM4,SCG1,SCG2,SCB1,SCB2) | |
8579 | C********************************************************************** | |
8580 | C | |
8581 | C calculation of scale factors | |
8582 | C (mass dependent couplings and slopes) | |
8583 | C | |
8584 | C input: XM1..XM4 external masses | |
8585 | C | |
8586 | C output: SCG1,SCG2 scales of coupling constants | |
8587 | C SCB1,SCB2 scales of coupling slope parameter | |
8588 | C | |
8589 | C********************************************************************* | |
8590 | IMPLICIT DOUBLE PRECISION (A-H,O-Z) | |
8591 | SAVE | |
8592 | ||
8593 | PARAMETER ( EPS = 1.D-3 ) | |
8594 | ||
8595 | C input/output channels | |
8596 | INTEGER LI,LO | |
8597 | COMMON /POINOU/ LI,LO | |
8598 | C event debugging information | |
8599 | INTEGER NMAXD | |
8600 | PARAMETER (NMAXD=100) | |
8601 | INTEGER IDEB,KSPOM,KHPOM,KSREG,KHDIR,KACCEP,KSTRG,KHTRG,KSLOO, | |
8602 | & KHLOO,KSDPO,KHDPO,KEVENT,KSOFT,KHARD | |
8603 | COMMON /PODEBG/ IDEB(NMAXD),KSPOM,KHPOM,KSREG,KHDIR,KACCEP,KSTRG, | |
8604 | & KHTRG,KSLOO,KHLOO,KSDPO,KHDPO,KEVENT,KSOFT,KHARD | |
8605 | C Reggeon phenomenology parameters | |
8606 | DOUBLE PRECISION ALPOM,ALPOMP,GP,B0POM,ALREG,ALREGP,GR,B0REG, | |
8607 | & GPPP,GPPR,B0PPP,B0PPR,VDMFAC,VDMQ2F,B0HAR,AKFAC | |
8608 | COMMON /POPREG/ ALPOM,ALPOMP,GP(2),B0POM(2), | |
8609 | & ALREG,ALREGP,GR(2),B0REG(2), | |
8610 | & GPPP,GPPR,B0PPP,B0PPR, | |
8611 | & VDMFAC(4),VDMQ2F(4),B0HAR,AKFAC | |
8612 | C parameters of 2x2 channel model | |
8613 | DOUBLE PRECISION PHISUP,RMASS,VAR,AMPFAC,ELAFAC,VFAC | |
8614 | COMMON /PO2CHA/ PHISUP(2),RMASS(2),VAR,AMPFAC(4),ELAFAC(4),VFAC | |
8615 | C data of c.m. system of Pomeron / Reggeon exchange | |
8616 | INTEGER NPOSP,IDPDG1,IDBAM1,IDPDG2,IDBAM2 | |
8617 | DOUBLE PRECISION ECMP,PCMP,PMASSP,PVIRTP,GAMBEP, | |
8618 | & SIDP,CODP,SIFP,COFP | |
8619 | COMMON /POPCMS/ ECMP,PCMP,PMASSP(2),PVIRTP(2),GAMBEP(4), | |
8620 | & SIDP,CODP,SIFP,COFP,NPOSP(2), | |
8621 | & IDPDG1,IDBAM1,IDPDG2,IDBAM2 | |
8622 | C model switches and parameters | |
8623 | CHARACTER*8 MDLNA | |
8624 | INTEGER ISWMDL,IPAMDL | |
8625 | DOUBLE PRECISION PARMDL | |
8626 | COMMON /POMDLS/ MDLNA(50),ISWMDL(50),PARMDL(400),IPAMDL(400) | |
8627 | ||
8628 | C scale factors for couplings | |
8629 | ECMMIN = 2.D0 | |
8630 | * ECMTP = 6.D0 | |
8631 | ECMTP = 1.D0 | |
8632 | IF(ABS(XM1-XM3).GT.EPS) THEN | |
8633 | IF(ECMP.LT.ECMTP) THEN | |
8634 | SCG1 = PHISUP(1)*LOG(ECMP**2/ECMMIN)/LOG(ECMTP**2/ECMMIN) | |
8635 | ELSE | |
8636 | SCG1 = PHISUP(1) | |
8637 | ENDIF | |
8638 | ELSE | |
8639 | SCG1 = 1.D0 | |
8640 | ENDIF | |
8641 | IF(ABS(XM2-XM4).GT.EPS) THEN | |
8642 | IF(ECMP.LT.ECMTP) THEN | |
8643 | SCG2 = PHISUP(2)*LOG(ECMP**2/ECMMIN)/LOG(ECMTP**2/ECMMIN) | |
8644 | ELSE | |
8645 | SCG2 = PHISUP(2) | |
8646 | ENDIF | |
8647 | ELSE | |
8648 | SCG2 = 1.D0 | |
8649 | ENDIF | |
8650 | C | |
8651 | C scale factors for slope parameters | |
8652 | IF((ISWMDL(1).LT.2).OR.(IPAMDL(10).EQ.1)) THEN | |
8653 | SCB1 = 1.D0 | |
8654 | SCB2 = 1.D0 | |
8655 | ELSE IF(ISWMDL(1).EQ.2) THEN | |
8656 | C rational | |
8657 | SCB1 = 2.D0*PMASSP(1)**2/(XM1**2+XM3**2) | |
8658 | SCB2 = 2.D0*PMASSP(2)**2/(XM2**2+XM4**2) | |
8659 | ELSE IF(ISWMDL(1).GE.3) THEN | |
8660 | C symmetric gaussian | |
8661 | SCB1 = VAR*(XM1-XM3)**2 | |
8662 | IF(SCB1.LT.25.D0) THEN | |
8663 | SCB1 = EXP(-SCB1) | |
8664 | ELSE | |
8665 | SCB1 = 0.D0 | |
8666 | ENDIF | |
8667 | SCB2 = VAR*(XM2-XM4)**2 | |
8668 | IF(SCB2.LT.25.D0) THEN | |
8669 | SCB2 = EXP(-SCB2) | |
8670 | ELSE | |
8671 | SCB2 = 0.D0 | |
8672 | ENDIF | |
8673 | ELSE | |
8674 | WRITE(LO,'(/,1X,A,I4)') 'PHO_SCALES:ERROR:invalid ISWMDL(1)', | |
8675 | & ISWMDL(1) | |
8676 | CALL PHO_ABORT | |
8677 | ENDIF | |
8678 | C debug output | |
8679 | IF(IDEB(65).GE.10) THEN | |
8680 | WRITE(LO,'(1X,A,4E11.3)') 'PHO_SCALES: M1..M4 ', | |
8681 | & XM1,XM2,XM3,XM4 | |
8682 | WRITE(LO,'(5X,A,4E11.3)') 'SCB1,SCB2,SCG1,SCG2', | |
8683 | & SCB1,SCB2,SCG1,SCG2 | |
8684 | ENDIF | |
8685 | END | |
8686 | ||
8687 | *$ CREATE PHO_EIKON.FOR | |
8688 | *COPY PHO_EIKON | |
8689 | CDECK ID>, PHO_EIKON | |
8690 | SUBROUTINE PHO_EIKON(IP,IFHARD,B) | |
8691 | C********************************************************************* | |
8692 | C | |
8693 | C calculation of unitarized amplitudes | |
8694 | C | |
8695 | C input: IP particle combination | |
8696 | C IFHARD -1 ignore previously calculated Born | |
8697 | C cross sections | |
8698 | C 0 calculate hard Born cross sections or | |
8699 | C take them from interpolation table | |
8700 | C (if available) | |
8701 | C 1 take hard cross sections from /POSBRN/ | |
8702 | C B impact parameter (mb**(1/2)) | |
8703 | C /POSBRN/ input cross sections | |
8704 | C /GLOCMS/ cm energy | |
8705 | C /POPREG/ soft and hard parameters | |
8706 | C | |
8707 | C output: /POINT4/ | |
8708 | C AMPEL purely elastic amplitude | |
8709 | C AMPVM quasi-elastically vectormeson prod. | |
8710 | C AMLMSD(2) amplitudes of low mass sing. diffr. | |
8711 | C AMHMSD(2) amplitudes of high mass sing. diffr. | |
8712 | C AMLMDD amplitude of low mass double diffr. | |
8713 | C AMHMDD amplitude of high mass double diffr. | |
8714 | C | |
8715 | C********************************************************************* | |
8716 | IMPLICIT DOUBLE PRECISION (A-H,O-Z) | |
8717 | SAVE | |
8718 | ||
8719 | PARAMETER(ITWO=2, | |
8720 | & ITHREE=3, | |
8721 | & IFOUR=4, | |
8722 | & IFIVE=5, | |
8723 | & ISIX=6, | |
8724 | & FIVE=5.D0, | |
8725 | & THOUS=1.D3, | |
8726 | & EXPMAX=70.D0, | |
8727 | & DEPS=1.D-20) | |
8728 | ||
8729 | C input/output channels | |
8730 | INTEGER LI,LO | |
8731 | COMMON /POINOU/ LI,LO | |
8732 | C event debugging information | |
8733 | INTEGER NMAXD | |
8734 | PARAMETER (NMAXD=100) | |
8735 | INTEGER IDEB,KSPOM,KHPOM,KSREG,KHDIR,KACCEP,KSTRG,KHTRG,KSLOO, | |
8736 | & KHLOO,KSDPO,KHDPO,KEVENT,KSOFT,KHARD | |
8737 | COMMON /PODEBG/ IDEB(NMAXD),KSPOM,KHPOM,KSREG,KHDIR,KACCEP,KSTRG, | |
8738 | & KHTRG,KSLOO,KHLOO,KSDPO,KHDPO,KEVENT,KSOFT,KHARD | |
8739 | C complex Born graph amplitudes used for unitarization | |
8740 | COMPLEX*16 AMPEL,AMPVM,AMPSOF,AMPHAR,AMLMSD,AMHMSD,AMLMDD, | |
8741 | & AMHMDD,AMPDP | |
8742 | COMMON /POINT4/ AMPEL,AMPVM(4,4),AMPSOF,AMPHAR,AMLMSD(2), | |
8743 | & AMHMSD(2),AMLMDD,AMHMDD,AMPDP(4) | |
8744 | C cross sections | |
8745 | INTEGER IPFIL,IFAFIL,IFBFIL | |
8746 | DOUBLE PRECISION SIGTOT,SIGELA,SIGVM,SIGINE,SIGNDF,SIGDIR, | |
8747 | & SIGLSD,SIGHSD,SIGLDD,SIGHDD,SIGCDF, | |
8748 | & SIGPOM,SIGREG,SIGHAR,SIGTR1,SIGTR2,SIGLOO, | |
8749 | & SIGDPO,SIG1SO,SIG1HA,SLOEL,SLOVM,SIGCOR, | |
8750 | & FSUP,FSUD,FSUH,ECMFIL,P2AFIL,P2BFIL | |
8751 | COMMON /POCSEC/ SIGTOT,SIGELA,SIGVM(0:4,0:4),SIGINE,SIGNDF,SIGDIR, | |
8752 | & SIGLSD(2),SIGHSD(2),SIGLDD,SIGHDD,SIGCDF(0:4), | |
8753 | & SIGPOM,SIGREG,SIGHAR,SIGTR1(2),SIGTR2(2),SIGLOO, | |
8754 | & SIGDPO(4),SIG1SO,SIG1HA,SLOEL,SLOVM(4,4),SIGCOR, | |
8755 | & FSUP(2),FSUD(2),FSUH(2),ECMFIL,P2AFIL,P2BFIL, | |
8756 | & IPFIL,IFAFIL,IFBFIL | |
8757 | C Born graph cross sections and slopes | |
8758 | INTEGER Max_pro_3 | |
8759 | PARAMETER ( Max_pro_3 = 16 ) | |
8760 | COMPLEX*16 SIGP,SIGR,SIGHD,SIGHR,SIGT1,SIGT2,SIGL,SIGDP, | |
8761 | & SIGD1,SIGD2,DSIGH | |
8762 | COMMON /POSBRN/ SIGP,SIGR,SIGHD,SIGHR,SIGT1(2),SIGT2(2),SIGL, | |
8763 | & SIGDP(4),SIGD1(2),SIGD2(2),DSIGH(0:Max_pro_3) | |
8764 | C scaled cross sections and slopes | |
8765 | COMPLEX*16 ZIGP,ZIGR,ZIGHD,ZIGHR,ZIGT1,ZIGT2,ZIGL,ZIGDP, | |
8766 | & ZIGD1,ZIGD2, | |
8767 | & BPOM,BREG,BHAR,BHAD,BTR1,BTR2,BLOO,BDP,BD1,BD2 | |
8768 | COMMON /POZBRN/ ZIGP,ZIGR,ZIGHD,ZIGHR,ZIGT1(2),ZIGT2(2),ZIGL, | |
8769 | & ZIGDP(4),ZIGD1(2),ZIGD2(2), | |
8770 | & BPOM,BREG,BHAR,BHAD,BTR1(2),BTR2(2),BLOO,BDP(4), | |
8771 | & BD1(2),BD2(2) | |
8772 | C Born graph cross sections after applying diffraction model | |
8773 | DOUBLE PRECISION SBOPOM,SBOREG,SBOHAR,SBOHAD,SBOTR1,SBOTR2, | |
8774 | & SBOLPO,SBODPO | |
8775 | COMMON /POINT1/ SBOPOM(0:4),SBOREG(0:4),SBOHAR(0:4),SBOHAD(0:4), | |
8776 | & SBOTR1(0:4,2),SBOTR2(0:4,2),SBOLPO(0:4), | |
8777 | & SBODPO(0:4,4) | |
8778 | C global event kinematics and particle IDs | |
8779 | INTEGER IFPAP,IFPAB | |
8780 | DOUBLE PRECISION ECM,PCM,PMASS,PVIRT | |
8781 | COMMON /POGCMS/ ECM,PCM,PMASS(2),PVIRT(2),IFPAP(2),IFPAB(2) | |
8782 | C data of c.m. system of Pomeron / Reggeon exchange | |
8783 | INTEGER NPOSP,IDPDG1,IDBAM1,IDPDG2,IDBAM2 | |
8784 | DOUBLE PRECISION ECMP,PCMP,PMASSP,PVIRTP,GAMBEP, | |
8785 | & SIDP,CODP,SIFP,COFP | |
8786 | COMMON /POPCMS/ ECMP,PCMP,PMASSP(2),PVIRTP(2),GAMBEP(4), | |
8787 | & SIDP,CODP,SIFP,COFP,NPOSP(2), | |
8788 | & IDPDG1,IDBAM1,IDPDG2,IDBAM2 | |
8789 | C Reggeon phenomenology parameters | |
8790 | DOUBLE PRECISION ALPOM,ALPOMP,GP,B0POM,ALREG,ALREGP,GR,B0REG, | |
8791 | & GPPP,GPPR,B0PPP,B0PPR,VDMFAC,VDMQ2F,B0HAR,AKFAC | |
8792 | COMMON /POPREG/ ALPOM,ALPOMP,GP(2),B0POM(2), | |
8793 | & ALREG,ALREGP,GR(2),B0REG(2), | |
8794 | & GPPP,GPPR,B0PPP,B0PPR, | |
8795 | & VDMFAC(4),VDMQ2F(4),B0HAR,AKFAC | |
8796 | C parameters of 2x2 channel model | |
8797 | DOUBLE PRECISION PHISUP,RMASS,VAR,AMPFAC,ELAFAC,VFAC | |
8798 | COMMON /PO2CHA/ PHISUP(2),RMASS(2),VAR,AMPFAC(4),ELAFAC(4),VFAC | |
8799 | C model switches and parameters | |
8800 | CHARACTER*8 MDLNA | |
8801 | INTEGER ISWMDL,IPAMDL | |
8802 | DOUBLE PRECISION PARMDL | |
8803 | COMMON /POMDLS/ MDLNA(50),ISWMDL(50),PARMDL(400),IPAMDL(400) | |
8804 | C unitarized amplitudes for different diffraction channels | |
8805 | DOUBLE PRECISION ZXP,BXP,ZXR,BXR,ZXH,BXH,ZXD,BXD, | |
8806 | & ZXT1A,BXT1A,ZXT1B,BXT1B,ZXT2A,BXT2A,ZXT2B,BXT2B, | |
8807 | & ZXDPE,BXDPE,ZXDPA,BXDPA,ZXDPB,BXDPB,ZXDPD,BXDPD, | |
8808 | & ZXL,BXL | |
8809 | COMMON /POINT5/ ZXP(4,4),BXP(4,4),ZXR(4,4),BXR(4,4), | |
8810 | & ZXH(4,4),BXH(4,4),ZXD(4,4),BXD(4,4), | |
8811 | & ZXT1A(4,4),BXT1A(4,4),ZXT1B(4,4),BXT1B(4,4), | |
8812 | & ZXT2A(4,4),BXT2A(4,4),ZXT2B(4,4),BXT2B(4,4), | |
8813 | & ZXDPE(4,4),BXDPE(4,4),ZXDPA(4,4),BXDPA(4,4), | |
8814 | & ZXDPB(4,4),BXDPB(4,4),ZXDPD(4,4),BXDPD(4,4), | |
8815 | & ZXL(4,4),BXL(4,4) | |
8816 | ||
8817 | COMPLEX*16 CZERO,CONE,B24,AUXP,AUXR,AUXH,AUXD,AUXT1,AUXT2, | |
8818 | & AUXL,AMPR,AMPO,AMPP,AMPQ | |
8819 | ||
8820 | DIMENSION PVOLD(2) | |
8821 | ||
8822 | DATA ELAST / 0.D0 / | |
8823 | DATA IPOLD / -1 / | |
8824 | DATA PVOLD / -1.D0, -1.D0 / | |
8825 | DATA XMPOM / 0.766D0 / | |
8826 | DATA XMVDM / 0.766D0 / | |
8827 | ||
8828 | DCMPLX(X,Y) = CMPLX(X,Y) | |
8829 | ||
8830 | C calculation of scaled cross sections and slopes | |
8831 | ||
8832 | C test for redundant calculation | |
8833 | IF((ECM.NE.ELAST).OR.(IFHARD.EQ.-1).OR.(PVIRT(1).NE.PVOLD(1)) | |
8834 | & .OR.(PVIRT(2).NE.PVOLD(2)).OR.(IP.NE.IPOLD)) THEN | |
8835 | C effective particle masses, VDM assumption | |
8836 | XMASS1 = PMASS(1) | |
8837 | XMASS2 = PMASS(2) | |
8838 | RMASS1 = RMASS(1) | |
8839 | RMASS2 = RMASS(2) | |
8840 | IF(IFPAP(1).EQ.22) THEN | |
8841 | XMASS1 = XMVDM | |
8842 | ELSE IF(IFPAP(1).EQ.990) THEN | |
8843 | XMASS1 = XMPOM | |
8844 | ENDIF | |
8845 | IF(IFPAP(2).EQ.22) THEN | |
8846 | XMASS2 = XMVDM | |
8847 | ELSE IF(IFPAP(2).EQ.990) THEN | |
8848 | XMASS2 = XMPOM | |
8849 | ENDIF | |
8850 | C different particle combinations | |
8851 | IF(IP.EQ.3) THEN | |
8852 | XMASS1 = XMASS2 | |
8853 | RMASS1 = RMASS2 | |
8854 | ELSE IF(IP.EQ.4) THEN | |
8855 | XMASS1 = XMPOM | |
8856 | RMASS1 = XMASS1 | |
8857 | ENDIF | |
8858 | IF(IP.GT.1) THEN | |
8859 | XMASS2 = XMPOM | |
8860 | RMASS2 = XMASS2 | |
8861 | ENDIF | |
8862 | C update pomeron CM system | |
8863 | PMASSP(1) = XMASS1 | |
8864 | PMASSP(2) = XMASS2 | |
8865 | ECMP = ECM | |
8866 | ||
8867 | CZERO = DCMPLX(0.D0,0.D0) | |
8868 | CONE = DCMPLX(1.D0,0.D0) | |
8869 | ELAST = ECM | |
8870 | PVOLD(1) = PVIRT(1) | |
8871 | PVOLD(2) = PVIRT(2) | |
8872 | IPOLD = IP | |
8873 | ||
8874 | C purely elastic scattering | |
8875 | CALL PHO_BORNCS(IP,IFHARD,XMASS1,XMASS2,XMASS1,XMASS2) | |
8876 | ZXP(1,1) = ZIGP | |
8877 | BXP(1,1) = BPOM | |
8878 | ZXR(1,1) = ZIGR | |
8879 | BXR(1,1) = BREG | |
8880 | ZXH(1,1) = ZIGHR | |
8881 | BXH(1,1) = BHAR | |
8882 | ZXD(1,1) = ZIGHD | |
8883 | BXD(1,1) = BHAD | |
8884 | ZXT1A(1,1) = ZIGT1(1) | |
8885 | BXT1A(1,1) = BTR1(1) | |
8886 | ZXT1B(1,1) = ZIGT1(2) | |
8887 | BXT1B(1,1) = BTR1(2) | |
8888 | ZXT2A(1,1) = ZIGT2(1) | |
8889 | BXT2A(1,1) = BTR2(1) | |
8890 | ZXT2B(1,1) = ZIGT2(2) | |
8891 | BXT2B(1,1) = BTR2(2) | |
8892 | ZXL(1,1) = ZIGL | |
8893 | BXL(1,1) = BLOO | |
8894 | ZXDPE(1,1) = ZIGDP(1) | |
8895 | BXDPE(1,1) = BDP(1) | |
8896 | ZXDPA(1,1) = ZIGDP(2) | |
8897 | BXDPA(1,1) = BDP(2) | |
8898 | ZXDPB(1,1) = ZIGDP(3) | |
8899 | BXDPB(1,1) = BDP(3) | |
8900 | ZXDPD(1,1) = ZIGDP(4) | |
8901 | BXDPD(1,1) = BDP(4) | |
8902 | SBOPOM(1) = SIGP | |
8903 | SBOREG(1) = SIGR | |
8904 | SBOHAR(1) = SIGHR | |
8905 | SBOHAD(1) = SIGHD | |
8906 | SBOTR1(1,1) = SIGT1(1) | |
8907 | SBOTR1(1,2) = SIGT1(2) | |
8908 | SBOTR2(1,1) = SIGT2(1) | |
8909 | SBOTR2(1,2) = SIGT2(2) | |
8910 | SBOLPO(1) = SIGL | |
8911 | SBODPO(1,1) = SIGDP(1) | |
8912 | SBODPO(1,2) = SIGDP(2) | |
8913 | SBODPO(1,3) = SIGDP(3) | |
8914 | SBODPO(1,4) = SIGDP(4) | |
8915 | ||
8916 | C low mass single diffractive scattering 1 | |
8917 | CALL PHO_BORNCS(IP,1,XMASS1,XMASS2,RMASS1,XMASS2) | |
8918 | ZXP(1,2) = ZIGP | |
8919 | BXP(1,2) = BPOM | |
8920 | ZXR(1,2) = ZIGR | |
8921 | BXR(1,2) = BREG | |
8922 | ZXH(1,2) = ZIGHR | |
8923 | BXH(1,2) = BHAR | |
8924 | ZXD(1,2) = ZIGHD | |
8925 | BXD(1,2) = BHAD | |
8926 | ZXT1A(1,2) = ZIGT1(1) | |
8927 | BXT1A(1,2) = BTR1(1) | |
8928 | ZXT1B(1,2) = ZIGT1(2) | |
8929 | BXT1B(1,2) = BTR1(2) | |
8930 | ZXT2A(1,2) = ZIGT2(1) | |
8931 | BXT2A(1,2) = BTR2(1) | |
8932 | ZXT2B(1,2) = ZIGT2(2) | |
8933 | BXT2B(1,2) = BTR2(2) | |
8934 | ZXL(1,2) = ZIGL | |
8935 | BXL(1,2) = BLOO | |
8936 | ZXDPE(1,2) = ZIGDP(1) | |
8937 | BXDPE(1,2) = BDP(1) | |
8938 | ZXDPA(1,2) = ZIGDP(2) | |
8939 | BXDPA(1,2) = BDP(2) | |
8940 | ZXDPB(1,2) = ZIGDP(3) | |
8941 | BXDPB(1,2) = BDP(3) | |
8942 | ZXDPD(1,2) = ZIGDP(4) | |
8943 | BXDPD(1,2) = BDP(4) | |
8944 | SBOPOM(2) = SIGP | |
8945 | SBOREG(2) = SIGR | |
8946 | SBOHAR(2) = SIGHR | |
8947 | SBOHAD(2) = 0.D0 | |
8948 | SBOTR1(2,1) = SIGT1(1) | |
8949 | SBOTR1(2,2) = SIGT1(2) | |
8950 | SBOTR2(2,1) = SIGT2(1) | |
8951 | SBOTR2(2,2) = SIGT2(2) | |
8952 | SBOLPO(2) = SIGL | |
8953 | SBODPO(2,1) = SIGDP(1) | |
8954 | SBODPO(2,2) = SIGDP(2) | |
8955 | SBODPO(2,3) = SIGDP(3) | |
8956 | SBODPO(2,4) = SIGDP(4) | |
8957 | ||
8958 | C low mass single diffractive scattering 2 | |
8959 | CALL PHO_BORNCS(IP,1,XMASS1,XMASS2,XMASS1,RMASS2) | |
8960 | ZXP(1,3) = ZIGP | |
8961 | BXP(1,3) = BPOM | |
8962 | ZXR(1,3) = ZIGR | |
8963 | BXR(1,3) = BREG | |
8964 | ZXH(1,3) = ZIGHR | |
8965 | BXH(1,3) = BHAR | |
8966 | ZXD(1,3) = ZIGHD | |
8967 | BXD(1,3) = BHAD | |
8968 | ZXT1A(1,3) = ZIGT1(1) | |
8969 | BXT1A(1,3) = BTR1(1) | |
8970 | ZXT1B(1,3) = ZIGT1(2) | |
8971 | BXT1B(1,3) = BTR1(2) | |
8972 | ZXT2A(1,3) = ZIGT2(1) | |
8973 | BXT2A(1,3) = BTR2(1) | |
8974 | ZXT2B(1,3) = ZIGT2(2) | |
8975 | BXT2B(1,3) = BTR2(2) | |
8976 | ZXL(1,3) = ZIGL | |
8977 | BXL(1,3) = BLOO | |
8978 | ZXDPE(1,3) = ZIGDP(1) | |
8979 | BXDPE(1,3) = BDP(1) | |
8980 | ZXDPA(1,3) = ZIGDP(2) | |
8981 | BXDPA(1,3) = BDP(2) | |
8982 | ZXDPB(1,3) = ZIGDP(3) | |
8983 | BXDPB(1,3) = BDP(3) | |
8984 | ZXDPD(1,3) = ZIGDP(4) | |
8985 | BXDPD(1,3) = BDP(4) | |
8986 | SBOPOM(3) = SIGP | |
8987 | SBOREG(3) = SIGR | |
8988 | SBOHAR(3) = SIGHR | |
8989 | SBOHAD(3) = 0.D0 | |
8990 | SBOTR1(3,1) = SIGT1(1) | |
8991 | SBOTR1(3,2) = SIGT1(2) | |
8992 | SBOTR2(3,1) = SIGT2(1) | |
8993 | SBOTR2(3,2) = SIGT2(2) | |
8994 | SBOLPO(3) = SIGL | |
8995 | SBODPO(3,1) = SIGDP(1) | |
8996 | SBODPO(3,2) = SIGDP(2) | |
8997 | SBODPO(3,3) = SIGDP(3) | |
8998 | SBODPO(3,4) = SIGDP(4) | |
8999 | ||
9000 | C low mass double diffractive scattering | |
9001 | CALL PHO_BORNCS(IP,1,XMASS1,XMASS2,RMASS1,RMASS2) | |
9002 | ZXP(1,4) = ZIGP | |
9003 | BXP(1,4) = BPOM | |
9004 | ZXR(1,4) = ZIGR | |
9005 | BXR(1,4) = BREG | |
9006 | ZXH(1,4) = ZIGHR | |
9007 | BXH(1,4) = BHAR | |
9008 | ZXD(1,4) = ZIGHD | |
9009 | BXD(1,4) = BHAD | |
9010 | ZXT1A(1,4) = ZIGT1(1) | |
9011 | BXT1A(1,4) = BTR1(1) | |
9012 | ZXT1B(1,4) = ZIGT1(2) | |
9013 | BXT1B(1,4) = BTR1(2) | |
9014 | ZXT2A(1,4) = ZIGT2(1) | |
9015 | BXT2A(1,4) = BTR2(1) | |
9016 | ZXT2B(1,4) = ZIGT2(2) | |
9017 | BXT2B(1,4) = BTR2(2) | |
9018 | ZXL(1,4) = ZIGL | |
9019 | BXL(1,4) = BLOO | |
9020 | ZXDPE(1,4) = ZIGDP(1) | |
9021 | BXDPE(1,4) = BDP(1) | |
9022 | ZXDPA(1,4) = ZIGDP(2) | |
9023 | BXDPA(1,4) = BDP(2) | |
9024 | ZXDPB(1,4) = ZIGDP(3) | |
9025 | BXDPB(1,4) = BDP(3) | |
9026 | ZXDPD(1,4) = ZIGDP(4) | |
9027 | BXDPD(1,4) = BDP(4) | |
9028 | SBOPOM(4) = SIGP | |
9029 | SBOREG(4) = SIGR | |
9030 | SBOHAR(4) = SIGHR | |
9031 | SBOHAD(4) = 0.D0 | |
9032 | SBOTR1(4,1) = SIGT1(1) | |
9033 | SBOTR1(4,2) = SIGT1(2) | |
9034 | SBOTR2(4,1) = SIGT2(1) | |
9035 | SBOTR2(4,2) = SIGT2(2) | |
9036 | SBOLPO(4) = SIGL | |
9037 | SBODPO(4,1) = SIGDP(1) | |
9038 | SBODPO(4,2) = SIGDP(2) | |
9039 | SBODPO(4,3) = SIGDP(3) | |
9040 | SBODPO(4,4) = SIGDP(4) | |
9041 | ||
9042 | C calculate Born graph cross sections | |
9043 | SBOPOM(0) = 0.D0 | |
9044 | SBOREG(0) = 0.D0 | |
9045 | SBOHAR(0) = 0.D0 | |
9046 | SBOHAD(0) = 0.D0 | |
9047 | SBOTR1(0,1) = 0.D0 | |
9048 | SBOTR1(0,2) = 0.D0 | |
9049 | SBOTR2(0,1) = 0.D0 | |
9050 | SBOTR2(0,2) = 0.D0 | |
9051 | SBOLPO(0) = 0.D0 | |
9052 | SBODPO(0,1) = 0.D0 | |
9053 | SBODPO(0,2) = 0.D0 | |
9054 | SBODPO(0,3) = 0.D0 | |
9055 | SBODPO(0,4) = 0.D0 | |
9056 | DO 150 I=1,4 | |
9057 | SBOPOM(0) = SBOPOM(0) + ELAFAC(I)*SBOPOM(I) | |
9058 | SBOREG(0) = SBOREG(0) + ELAFAC(I)*SBOREG(I) | |
9059 | SBOHAR(0) = SBOHAR(0) + ELAFAC(I)*SBOHAR(I) | |
9060 | SBOHAD(0) = SBOHAD(0) + ELAFAC(I)*SBOHAD(I) | |
9061 | SBOTR1(0,1) = SBOTR1(0,1) + ELAFAC(I)*SBOTR1(I,1) | |
9062 | SBOTR1(0,2) = SBOTR1(0,2) + ELAFAC(I)*SBOTR1(I,2) | |
9063 | SBOTR2(0,1) = SBOTR2(0,1) + ELAFAC(I)*SBOTR2(I,1) | |
9064 | SBOTR2(0,2) = SBOTR2(0,2) + ELAFAC(I)*SBOTR2(I,2) | |
9065 | SBOLPO(0) = SBOLPO(0) + ELAFAC(I)*SBOLPO(I) | |
9066 | SBODPO(0,1) = SBODPO(0,1) + ELAFAC(I)*SBODPO(I,1) | |
9067 | SBODPO(0,2) = SBODPO(0,2) + ELAFAC(I)*SBODPO(I,2) | |
9068 | SBODPO(0,3) = SBODPO(0,3) + ELAFAC(I)*SBODPO(I,3) | |
9069 | SBODPO(0,4) = SBODPO(0,4) + ELAFAC(I)*SBODPO(I,4) | |
9070 | 150 CONTINUE | |
9071 | ||
9072 | SIGPOM = SBOPOM(0) | |
9073 | SIGREG = SBOREG(0) | |
9074 | SIGTR1(1) = SBOTR1(0,1) | |
9075 | SIGTR1(2) = SBOTR1(0,2) | |
9076 | SIGTR2(1) = SBOTR2(0,1) | |
9077 | SIGTR2(2) = SBOTR2(0,2) | |
9078 | SIGLOO = SBOLPO(0) | |
9079 | SIGDPO(1) = SBODPO(0,1) | |
9080 | SIGDPO(2) = SBODPO(0,2) | |
9081 | SIGDPO(3) = SBODPO(0,3) | |
9082 | SIGDPO(4) = SBODPO(0,4) | |
9083 | SIGHAR = SBOHAR(0) | |
9084 | SIGDIR = SBOHAD(0) | |
9085 | ENDIF | |
9086 | ||
9087 | B24=DCMPLX(B**2,0.D0)/4.D0 | |
9088 | ||
9089 | AMPEL = CZERO | |
9090 | AMPR = CZERO | |
9091 | AMPO = CZERO | |
9092 | AMPP = CZERO | |
9093 | AMPQ = CZERO | |
9094 | AMLMSD(1) = CZERO | |
9095 | AMLMSD(2) = CZERO | |
9096 | AMHMSD(1) = CZERO | |
9097 | AMHMSD(2) = CZERO | |
9098 | AMLMDD = CZERO | |
9099 | AMHMDD = CZERO | |
9100 | ||
9101 | C different models | |
9102 | ||
9103 | IF(ISWMDL(1).LT.3) THEN | |
9104 | C pomeron | |
9105 | AUXP = ZXP(1,1)*EXP(-B24/BXP(1,1)) | |
9106 | C reggeon | |
9107 | AUXR = ZXR(1,1)*EXP(-B24/BXR(1,1)) | |
9108 | C hard resolved processes | |
9109 | AUXH = ZXH(1,1)*EXP(-B24/BXH(1,1)) | |
9110 | C hard direct processes | |
9111 | AUXD = ZXD(1,1)*EXP(-B24/BXD(1,1)) | |
9112 | C triple-Pomeron: baryon high mass diffraction | |
9113 | AUXT1 = ZXT1A(1,1)*EXP(-B24/BXT1A(1,1)) | |
9114 | & + ZXT1B(1,1)*EXP(-B24/BXT1B(1,1)) | |
9115 | C triple-Pomeron: photon/meson high mass diffraction | |
9116 | AUXT2 = ZXT2A(1,1)*EXP(-B24/BXT2A(1,1)) | |
9117 | & + ZXT2B(1,1)*EXP(-B24/BXT2B(1,1)) | |
9118 | C loop-Pomeron | |
9119 | AUXL = ZXL(1,1)*EXP(-B24/BXL(1,1)) | |
9120 | ENDIF | |
9121 | ||
9122 | IF(ISWMDL(1).EQ.0) THEN | |
9123 | AMPEL = 0.5D0*((VDMQ2F(1)+VDMQ2F(2)+VDMQ2F(3)+VDMQ2F(4)) | |
9124 | & *(CONE-EXP(-AUXR-AUXP-AUXH+AUXT1+AUXT2+AUXL)) | |
9125 | & +(CONE-(VDMQ2F(1)-VDMQ2F(2)-VDMQ2F(3)-VDMQ2F(4)))*AUXD | |
9126 | & ) | |
9127 | AMPR = 0.5D0*SQRT(VDMQ2F(1))*(CONE-EXP(-AUXR-AUXP-AUXH | |
9128 | & +AUXT1+AUXT2+AUXL)) | |
9129 | AMPO = 0.5D0*SQRT(VDMQ2F(2))*(CONE-EXP(-AUXR-AUXP-AUXH | |
9130 | & +AUXT1+AUXT2+AUXL)) | |
9131 | AMPP = 0.5D0*SQRT(VDMQ2F(3))*(CONE-EXP(-AUXR-AUXP-AUXH | |
9132 | & +AUXT1+AUXT2+AUXL)) | |
9133 | AMPQ = 0.5D0*SQRT(VDMQ2F(4))*(CONE-EXP(-AUXR-AUXP-AUXH | |
9134 | & +AUXT1+AUXT2+AUXL)) | |
9135 | ||
9136 | ELSE IF(ISWMDL(1).EQ.1) THEN | |
9137 | AMPR = 0.5D0*SQRT(VDMQ2F(1))* | |
9138 | & ( CONE-EXP(-AUXR-AUXP-AUXH*VDMQ2F(1)) ) | |
9139 | AMPO = 0.5D0*SQRT(VDMQ2F(2))* | |
9140 | & ( CONE-EXP(-3.D0*AUXR-AUXP-AUXH*VDMQ2F(2)) ) | |
9141 | AMPP = 0.5D0*SQRT(VDMQ2F(3))* | |
9142 | & ( CONE-EXP(-AUXP-AUXH*VDMQ2F(3)) ) | |
9143 | AMPQ = 0.5D0*SQRT(VDMQ2F(4))* | |
9144 | & ( CONE-EXP(-AUXR-AUXP-AUXH*VDMQ2F(4)) ) | |
9145 | AMPEL = SQRT(VDMQ2F(1))*AMPR | |
9146 | & + SQRT(VDMQ2F(2))*AMPO | |
9147 | & + SQRT(VDMQ2F(3))*AMPP | |
9148 | & + SQRT(VDMQ2F(4))*AMPQ | |
9149 | & + AUXD/2.D0 | |
9150 | ||
9151 | C simple analytic two channel model (version A) | |
9152 | ELSE IF(ISWMDL(1).EQ.3) THEN | |
9153 | CALL PHO_CHAN2A(B) | |
9154 | ||
9155 | ELSE | |
9156 | WRITE(LO,'(1X,A,I2)') | |
9157 | & 'EIKON: ERROR: unsupported model ISWMDL(1) ',ISWMDL(1) | |
9158 | STOP | |
9159 | ENDIF | |
9160 | ||
9161 | END | |
9162 | ||
9163 | *$ CREATE PHO_DSIGDT.FOR | |
9164 | *COPY PHO_DSIGDT | |
9165 | CDECK ID>, PHO_DSIGDT | |
9166 | SUBROUTINE PHO_DSIGDT(EE,XTA,NFILL) | |
9167 | C********************************************************************* | |
9168 | C | |
9169 | C calculation of unitarized amplitude | |
9170 | C and differential cross section | |
9171 | C | |
9172 | C input: EE cm energy (GeV) | |
9173 | C XTA(1,*) t values (GeV**2) | |
9174 | C NFILL entries in t table | |
9175 | C | |
9176 | C output: XTA(2,*) DSIG/DT g p --> g h/V (mub/GeV**2) | |
9177 | C XTA(3,*) DSIG/DT g p --> rho0 h/V | |
9178 | C XTA(4,*) DSIG/DT g p --> omega0 h/V | |
9179 | C XTA(5,*) DSIG/DT g p --> phi h/V | |
9180 | C XTA(6,*) DSIG/DT g p --> pi+ pi- h/V (continuum) | |
9181 | C | |
9182 | C********************************************************************* | |
9183 | IMPLICIT DOUBLE PRECISION (A-H,O-Z) | |
9184 | SAVE | |
9185 | ||
9186 | PARAMETER(ITWO=2, | |
9187 | & ITHREE=3, | |
9188 | & THOUS=1.D3, | |
9189 | & DEPS=1.D-20) | |
9190 | ||
9191 | DIMENSION XTA(6,NFILL) | |
9192 | ||
9193 | C input/output channels | |
9194 | INTEGER LI,LO | |
9195 | COMMON /POINOU/ LI,LO | |
9196 | C some constants | |
9197 | DOUBLE PRECISION PI,PI2,PI4,GEV2MB,Q_ch,Q_ch2,Q_ch4 | |
9198 | COMMON /POCONS/ PI,PI2,PI4,GEV2MB, | |
9199 | & Q_ch(-6:6),Q_ch2(-6:6),Q_ch4(-6:6) | |
9200 | C integration precision for hard cross sections (obsolete) | |
9201 | INTEGER NGAUP1,NGAUP2,NGAUET,NGAUIN,NGAUSO | |
9202 | COMMON /POGAUP/ NGAUP1,NGAUP2,NGAUET,NGAUIN,NGAUSO | |
9203 | C event debugging information | |
9204 | INTEGER NMAXD | |
9205 | PARAMETER (NMAXD=100) | |
9206 | INTEGER IDEB,KSPOM,KHPOM,KSREG,KHDIR,KACCEP,KSTRG,KHTRG,KSLOO, | |
9207 | & KHLOO,KSDPO,KHDPO,KEVENT,KSOFT,KHARD | |
9208 | COMMON /PODEBG/ IDEB(NMAXD),KSPOM,KHPOM,KSREG,KHDIR,KACCEP,KSTRG, | |
9209 | & KHTRG,KSLOO,KHLOO,KSDPO,KHDPO,KEVENT,KSOFT,KHARD | |
9210 | C global event kinematics and particle IDs | |
9211 | INTEGER IFPAP,IFPAB | |
9212 | DOUBLE PRECISION ECM,PCM,PMASS,PVIRT | |
9213 | COMMON /POGCMS/ ECM,PCM,PMASS(2),PVIRT(2),IFPAP(2),IFPAB(2) | |
9214 | C complex Born graph amplitudes used for unitarization | |
9215 | COMPLEX*16 AMPEL,AMPVM,AMPSOF,AMPHAR,AMLMSD,AMHMSD,AMLMDD, | |
9216 | & AMHMDD,AMPDP | |
9217 | COMMON /POINT4/ AMPEL,AMPVM(4,4),AMPSOF,AMPHAR,AMLMSD(2), | |
9218 | & AMHMSD(2),AMLMDD,AMHMDD,AMPDP(4) | |
9219 | ||
9220 | COMPLEX*16 XT,AMP,CZERO | |
9221 | DIMENSION AMP(5),XPNT(96),WGHT(96),XT(5,100) | |
9222 | CHARACTER*12 FNA | |
9223 | ||
9224 | CDABS(AMPEL) = ABS(AMPEL) | |
9225 | DCMPLX(X,Y) = CMPLX(X,Y) | |
9226 | ||
9227 | CZERO=DCMPLX(0.D0,0.D0) | |
9228 | ||
9229 | ETMP = ECM | |
9230 | ECM = EE | |
9231 | ||
9232 | IF(NFILL.GT.100) THEN | |
9233 | WRITE(LO,'(1X,A,I4)') | |
9234 | & 'PHO_DSIGDT:ERROR: too many entries in table',NFILL | |
9235 | STOP | |
9236 | ENDIF | |
9237 | C | |
9238 | DO 100 K=1,NFILL | |
9239 | DO 150 L=1,5 | |
9240 | XT(L,K)=CZERO | |
9241 | 150 CONTINUE | |
9242 | 100 CONTINUE | |
9243 | C | |
9244 | C impact parameter integration | |
9245 | C BMAX=12.D0*SQRT(MAX(BPOM,BREG)) | |
9246 | BMAX=10.D0 | |
9247 | CALL PHO_GAUSET(0.D0,BMAX,NGAUSO,XPNT,WGHT) | |
9248 | IAMP = 5 | |
9249 | IF((IFPAP(1).EQ.22).AND.(IFPAP(2).NE.22)) THEN | |
9250 | I1 = 1 | |
9251 | I2 = 0 | |
9252 | ELSE IF((IFPAP(1).NE.22).AND.(IFPAP(2).EQ.22)) THEN | |
9253 | I1 = 0 | |
9254 | I2 = 1 | |
9255 | ELSE IF((IFPAP(1).EQ.22).AND.(IFPAP(2).EQ.22)) THEN | |
9256 | I1 = 1 | |
9257 | I2 = 1 | |
9258 | ELSE | |
9259 | I1 = 0 | |
9260 | I2 = 0 | |
9261 | IAMP = 1 | |
9262 | ENDIF | |
9263 | J1 = I1*2 | |
9264 | K1 = I1*3 | |
9265 | L1 = I1*4 | |
9266 | J2 = I2*2 | |
9267 | K2 = I2*3 | |
9268 | L2 = I2*4 | |
9269 | C | |
9270 | DO 200 I=1,NGAUSO | |
9271 | WG=WGHT(I)*XPNT(I) | |
9272 | C calculate amplitudes | |
9273 | IF(I.EQ.1) THEN | |
9274 | CALL PHO_EIKON(1,-1,XPNT(I)) | |
9275 | ELSE | |
9276 | CALL PHO_EIKON(1,1,XPNT(I)) | |
9277 | ENDIF | |
9278 | AMP(1) = AMPEL | |
9279 | AMP(2) = AMPVM(I1,I2) | |
9280 | AMP(3) = AMPVM(J1,J2) | |
9281 | AMP(4) = AMPVM(K1,K2) | |
9282 | AMP(5) = AMPVM(L1,L2) | |
9283 | C | |
9284 | DO 400 J=1,NFILL | |
9285 | XX=XPNT(I)*SQRT(XTA(1,J)/GEV2MB) | |
9286 | FAC = PHO_BESSJ0(XX)*WG | |
9287 | DO 500 K=1,IAMP | |
9288 | XT(1,J)=XT(1,J)+AMP(K)*FAC | |
9289 | 500 CONTINUE | |
9290 | 400 CONTINUE | |
9291 | 200 CONTINUE | |
9292 | C | |
9293 | C change units to mb/GeV**2 | |
9294 | FAC = 4.D0*PI/GEV2MB | |
9295 | FNA = '(mb/GeV**2) ' | |
9296 | IF(I1+I2.EQ.1) THEN | |
9297 | FAC = FAC*THOUS | |
9298 | FNA = '(mub/GeV**2)' | |
9299 | ELSE IF(I1+I2.EQ.2) THEN | |
9300 | FAC = FAC*THOUS*THOUS | |
9301 | FNA = '(nb/GeV**2) ' | |
9302 | ENDIF | |
9303 | IF(IDEB(56).GE.5) THEN | |
9304 | WRITE(LO,'(1X,A,A12,/1X,A)') 'table: -T (GeV**2) DSIG/DT ', | |
9305 | & FNA,'------------------------------------------' | |
9306 | ENDIF | |
9307 | DO 600 J=1,NFILL | |
9308 | DO 700 K=1,IAMP | |
9309 | XTA(K+1,J)=CDABS(XT(K,J))**2*FAC | |
9310 | 700 CONTINUE | |
9311 | IF(IDEB(56).GE.5) THEN | |
9312 | WRITE(LO,'(5X,6E12.3)') (XTA(I,J),I=1,IAMP+1) | |
9313 | ENDIF | |
9314 | 600 CONTINUE | |
9315 | ||
9316 | ECM = ETMP | |
9317 | END | |
9318 | ||
9319 | *$ CREATE PHO_XSECT.FOR | |
9320 | *COPY PHO_XSECT | |
9321 | CDECK ID>, PHO_XSECT | |
9322 | SUBROUTINE PHO_XSECT(IP,IFHARD,EE) | |
9323 | C********************************************************************* | |
9324 | C | |
9325 | C calculation of physical cross sections | |
9326 | C | |
9327 | C input: IP particle combination | |
9328 | C IFHARD -1 reset Born graph cross section tables | |
9329 | C 0 calculate hard cross sections or take them | |
9330 | C from interpolation table (if available) | |
9331 | C 1 assume that hard cross sections are already | |
9332 | C calculated and stored in /POSBRN/ | |
9333 | C EE cms energy (GeV) | |
9334 | C | |
9335 | C output: /POSBRN/ input cross sections | |
9336 | C /POZBRN/ scaled input cross values | |
9337 | C /POCSEC/ physical cross sections and slopes | |
9338 | C | |
9339 | C slopes in GeV**-2, cross sections in mb | |
9340 | C | |
9341 | C********************************************************************* | |
9342 | IMPLICIT DOUBLE PRECISION (A-H,O-Z) | |
9343 | SAVE | |
9344 | ||
9345 | PARAMETER(ONEM=-1.D0, | |
9346 | & THOUS=1.D3, | |
9347 | & DEPS=1.D-20) | |
9348 | ||
9349 | C input/output channels | |
9350 | INTEGER LI,LO | |
9351 | COMMON /POINOU/ LI,LO | |
9352 | C some constants | |
9353 | DOUBLE PRECISION PI,PI2,PI4,GEV2MB,Q_ch,Q_ch2,Q_ch4 | |
9354 | COMMON /POCONS/ PI,PI2,PI4,GEV2MB, | |
9355 | & Q_ch(-6:6),Q_ch2(-6:6),Q_ch4(-6:6) | |
9356 | C event debugging information | |
9357 | INTEGER NMAXD | |
9358 | PARAMETER (NMAXD=100) | |
9359 | INTEGER IDEB,KSPOM,KHPOM,KSREG,KHDIR,KACCEP,KSTRG,KHTRG,KSLOO, | |
9360 | & KHLOO,KSDPO,KHDPO,KEVENT,KSOFT,KHARD | |
9361 | COMMON /PODEBG/ IDEB(NMAXD),KSPOM,KHPOM,KSREG,KHDIR,KACCEP,KSTRG, | |
9362 | & KHTRG,KSLOO,KHLOO,KSDPO,KHDPO,KEVENT,KSOFT,KHARD | |
9363 | C integration precision for hard cross sections (obsolete) | |
9364 | INTEGER NGAUP1,NGAUP2,NGAUET,NGAUIN,NGAUSO | |
9365 | COMMON /POGAUP/ NGAUP1,NGAUP2,NGAUET,NGAUIN,NGAUSO | |
9366 | C model switches and parameters | |
9367 | CHARACTER*8 MDLNA | |
9368 | INTEGER ISWMDL,IPAMDL | |
9369 | DOUBLE PRECISION PARMDL | |
9370 | COMMON /POMDLS/ MDLNA(50),ISWMDL(50),PARMDL(400),IPAMDL(400) | |
9371 | C Born graph cross sections and slopes | |
9372 | INTEGER Max_pro_3 | |
9373 | PARAMETER ( Max_pro_3 = 16 ) | |
9374 | COMPLEX*16 SIGP,SIGR,SIGHD,SIGHR,SIGT1,SIGT2,SIGL,SIGDP, | |
9375 | & SIGD1,SIGD2,DSIGH | |
9376 | COMMON /POSBRN/ SIGP,SIGR,SIGHD,SIGHR,SIGT1(2),SIGT2(2),SIGL, | |
9377 | & SIGDP(4),SIGD1(2),SIGD2(2),DSIGH(0:Max_pro_3) | |
9378 | C cross sections | |
9379 | INTEGER IPFIL,IFAFIL,IFBFIL | |
9380 | DOUBLE PRECISION SIGTOT,SIGELA,SIGVM,SIGINE,SIGNDF,SIGDIR, | |
9381 | & SIGLSD,SIGHSD,SIGLDD,SIGHDD,SIGCDF, | |
9382 | & SIGPOM,SIGREG,SIGHAR,SIGTR1,SIGTR2,SIGLOO, | |
9383 | & SIGDPO,SIG1SO,SIG1HA,SLOEL,SLOVM,SIGCOR, | |
9384 | & FSUP,FSUD,FSUH,ECMFIL,P2AFIL,P2BFIL | |
9385 | COMMON /POCSEC/ SIGTOT,SIGELA,SIGVM(0:4,0:4),SIGINE,SIGNDF,SIGDIR, | |
9386 | & SIGLSD(2),SIGHSD(2),SIGLDD,SIGHDD,SIGCDF(0:4), | |
9387 | & SIGPOM,SIGREG,SIGHAR,SIGTR1(2),SIGTR2(2),SIGLOO, | |
9388 | & SIGDPO(4),SIG1SO,SIG1HA,SLOEL,SLOVM(4,4),SIGCOR, | |
9389 | & FSUP(2),FSUD(2),FSUH(2),ECMFIL,P2AFIL,P2BFIL, | |
9390 | & IPFIL,IFAFIL,IFBFIL | |
9391 | C global event kinematics and particle IDs | |
9392 | INTEGER IFPAP,IFPAB | |
9393 | DOUBLE PRECISION ECM,PCM,PMASS,PVIRT | |
9394 | COMMON /POGCMS/ ECM,PCM,PMASS(2),PVIRT(2),IFPAP(2),IFPAB(2) | |
9395 | ||
9396 | CHARACTER*15 PHO_PNAME | |
9397 | ||
9398 | C complex Born graph amplitudes used for unitarization | |
9399 | COMPLEX*16 AMPEL,AMPVM,AMPSOF,AMPHAR,AMLMSD,AMHMSD,AMLMDD, | |
9400 | & AMHMDD,AMPDP | |
9401 | COMMON /POINT4/ AMPEL,AMPVM(4,4),AMPSOF,AMPHAR,AMLMSD(2), | |
9402 | & AMHMSD(2),AMLMDD,AMHMDD,AMPDP(4) | |
9403 | ||
9404 | DIMENSION XPNT(96),WGHT(96),SLVM1(4,4),SLVM2(4,4) | |
9405 | CHARACTER*8 VMESA(0:4),VMESB(0:4) | |
9406 | DATA VMESA / 'vmeson ','rho ','omega ','phi ', | |
9407 | & 'pi+pi- ' / | |
9408 | DATA VMESB / 'vmeson ','rho ','omega ','phi ', | |
9409 | & 'pi+pi- ' / | |
9410 | ||
9411 | CDABS(AMPEL) = ABS(AMPEL) | |
9412 | ||
9413 | ETMP = ECM | |
9414 | IF(EE.LT.0.D0) GOTO 500 | |
9415 | ECM = EE | |
9416 | ||
9417 | C impact parameter integration | |
9418 | C BMAX=12.D0*SQRT(MAX(BPOM,BREG)) | |
9419 | BMAX=10.D0 | |
9420 | CALL PHO_GAUSET(0.D0,BMAX,NGAUSO,XPNT,WGHT) | |
9421 | SIGTOT = 0.D0 | |
9422 | SIGINE = 0.D0 | |
9423 | SIGELA = 0.D0 | |
9424 | SIGNDF = 0.D0 | |
9425 | SIGLSD(1) = 0.D0 | |
9426 | SIGLSD(2) = 0.D0 | |
9427 | SIGLDD = 0.D0 | |
9428 | SIGHSD(1) = 0.D0 | |
9429 | SIGHSD(2) = 0.D0 | |
9430 | SIGHDD = 0.D0 | |
9431 | SIGCDF(0) = 0.D0 | |
9432 | SIG1SO = 0.D0 | |
9433 | SIG1HA = 0.D0 | |
9434 | SLEL1 = 0.D0 | |
9435 | SLEL2 = 0.D0 | |
9436 | DO 50 I=1,4 | |
9437 | SIGCDF(I) = 0.D0 | |
9438 | DO 55 K=1,4 | |
9439 | SIGVM(I,K) = 0.D0 | |
9440 | SLVM1(I,K) = 0.D0 | |
9441 | SLVM2(I,K) = 0.D0 | |
9442 | 55 CONTINUE | |
9443 | 50 CONTINUE | |
9444 | ||
9445 | DO 100 I=1,NGAUSO | |
9446 | B2 = XPNT(I)**2 | |
9447 | WG = WGHT(I)*XPNT(I) | |
9448 | WGB = B2*WG | |
9449 | ||
9450 | C calculate impact parameter amplitude, results in /POINT4/ | |
9451 | IF(I.EQ.1) THEN | |
9452 | CALL PHO_EIKON(IP,IFHARD,XPNT(I)) | |
9453 | ELSE | |
9454 | CALL PHO_EIKON(IP,1,XPNT(I)) | |
9455 | ENDIF | |
9456 | ||
9457 | SIGTOT = SIGTOT + DREAL(AMPEL)*WG | |
9458 | SIGELA = SIGELA + CDABS(AMPEL)**2*WG | |
9459 | SLEL1 = SLEL1 + AMPEL*WGB | |
9460 | SLEL2 = SLEL2 + AMPEL*WG | |
9461 | ||
9462 | DO 110 J=1,4 | |
9463 | DO 120 K=1,4 | |
9464 | SIGVM(J,K) = SIGVM(J,K) + CDABS(AMPVM(J,K))**2*WG | |
9465 | SLVM1(J,K) = SLVM1(J,K) + AMPVM(J,K)*WGB | |
9466 | SLVM2(J,K) = SLVM2(J,K) + AMPVM(J,K)*WG | |
9467 | 120 CONTINUE | |
9468 | SIGCDF(J) = SIGCDF(J) + DREAL(AMPDP(J))*WG | |
9469 | 110 CONTINUE | |
9470 | ||
9471 | SIGLSD(1) = SIGLSD(1) + CDABS(AMLMSD(1))**2*WG | |
9472 | SIGLSD(2) = SIGLSD(2) + CDABS(AMLMSD(2))**2*WG | |
9473 | SIGLDD = SIGLDD + CDABS(AMLMDD)**2*WG | |
9474 | SIG1SO = SIG1SO + DREAL(AMPSOF)*WG | |
9475 | SIG1HA = SIG1HA + DREAL(AMPHAR)*WG | |
9476 | SIGHSD(1) = SIGHSD(1) + DREAL(AMHMSD(1))*WG | |
9477 | SIGHSD(2) = SIGHSD(2) + DREAL(AMHMSD(2))*WG | |
9478 | SIGHDD = SIGHDD + DREAL(AMHMDD)*WG | |
9479 | ||
9480 | 100 CONTINUE | |
9481 | ||
9482 | SIGDIR = DREAL(SIGHD) | |
9483 | FAC = 4.D0*PI2 | |
9484 | SIGTOT = SIGTOT*FAC | |
9485 | SIGELA = SIGELA*FAC | |
9486 | FACSL = 0.5D0/GEV2MB | |
9487 | SLOEL = SLEL1/MAX(DEPS,SLEL2)*FACSL | |
9488 | ||
9489 | IF((IFPAP(1).EQ.22).OR.(IFPAP(2).EQ.22)) THEN | |
9490 | DO 130 I=1,4 | |
9491 | DO 140 J=1,4 | |
9492 | SIGVM(I,J) = SIGVM(I,J)*FAC | |
9493 | SLOVM(I,J) = SLVM1(I,J)/MAX(DEPS,SLVM2(I,J))*FACSL | |
9494 | 140 CONTINUE | |
9495 | 130 CONTINUE | |
9496 | SIGVM(0,0) = 0.D0 | |
9497 | DO 150 I=1,4 | |
9498 | SIGVM(0,I) = 0.D0 | |
9499 | SIGVM(I,0) = 0.D0 | |
9500 | DO 160 J=1,4 | |
9501 | SIGVM(0,I) = SIGVM(0,I) + SIGVM(J,I) | |
9502 | SIGVM(I,0) = SIGVM(I,0) + SIGVM(I,J) | |
9503 | 160 CONTINUE | |
9504 | SIGVM(0,0) = SIGVM(0,0) + SIGVM(I,0) | |
9505 | 150 CONTINUE | |
9506 | ENDIF | |
9507 | ||
9508 | C diffractive cross sections | |
9509 | ||
9510 | SIGLSD(1) = SIGLSD(1)*FAC*PARMDL(40) | |
9511 | SIGLSD(2) = SIGLSD(2)*FAC*PARMDL(41) | |
9512 | SIGLDD = SIGLDD *FAC*PARMDL(42) | |
9513 | SIGHSD(1) = (SIGHSD(1)-2.D0*(SIGCDF(1)+SIGCDF(2)))*FAC*PARMDL(40) | |
9514 | SIGHSD(2) = (SIGHSD(2)-2.D0*(SIGCDF(1)+SIGCDF(3)))*FAC*PARMDL(41) | |
9515 | SIGHDD = (SIGHDD-2.D0*(SIGCDF(2)+SIGCDF(3)+2.D0*SIGCDF(4))) | |
9516 | & *FAC*PARMDL(42) | |
9517 | ||
9518 | C double pomeron scattering | |
9519 | ||
9520 | SIGCDF(0) = 0.D0 | |
9521 | DO 170 I=1,4 | |
9522 | SIGCDF(I) = SIGCDF(I)*FAC | |
9523 | SIGCDF(0) = SIGCDF(0)+SIGCDF(I) | |
9524 | 170 CONTINUE | |
9525 | ||
9526 | SIG1SO = SIG1SO *FAC | |
9527 | SIG1HA = SIG1HA *FAC | |
9528 | ||
9529 | SIGINE = SIGTOT - SIGELA | |
9530 | ||
9531 | C user-forced change of diffractive cross section | |
9532 | ||
9533 | IF((IP.EQ.1).AND.(ISWMDL(30).GE.1)) THEN | |
9534 | ||
9535 | C use optional explicit parametrization for single-diffraction | |
9536 | ||
9537 | SIGSD1 = SIGLSD(1)+SIGHSD(1) | |
9538 | SIGSD2 = SIGLSD(2)+SIGHSD(2) | |
9539 | SS = EE*EE | |
9540 | XI_MIN = 1.5D0/SS | |
9541 | XI_MAX = PARMDL(45)**2 | |
9542 | CALL PHO_CSDIFF(IFPAP(1),IFPAP(2),SS,XI_MIN,XI_MAX, | |
9543 | & SIG_SD1,SIG_SD2,SIG_DD) | |
9544 | SIG_SD1 = SIG_SD1*PARMDL(40) | |
9545 | SIG_SD2 = SIG_SD2*PARMDL(41) | |
9546 | **sr | |
9547 | C DEL_SD1 = SIG_SD1-SIGSD1 | |
9548 | DEL_SD1 = PARMDL(200)*(SIG_SD1-SIGSD1) | |
9549 | ** | |
9550 | FAC = SIGLSD(1)/SIGSD1 | |
9551 | SIGLSD(1) = SIGLSD(1)+FAC*DEL_SD1 | |
9552 | SIGHSD(1) = SIGHSD(1)+(1.D0-FAC)*DEL_SD1 | |
9553 | C DEL_SD2 = SIG_SD2-SIGSD2 | |
9554 | DEL_SD2 = PARMDL(200)*(SIG_SD2-SIGSD2) | |
9555 | FAC = SIGLSD(2)/SIGSD2 | |
9556 | SIGLSD(2) = SIGLSD(2)+FAC*DEL_SD2 | |
9557 | SIGHSD(2) = SIGHSD(2)+(1.D0-FAC)*DEL_SD2 | |
9558 | ||
9559 | IF(ISWMDL(30).GE.2) THEN | |
9560 | ||
9561 | C use explicit parametrization also for double diffraction diss. | |
9562 | SIGDD = SIGLDD+SIGHDD | |
9563 | SIG_DD = SIG_DD*PARMDL(42) | |
9564 | DEL_DD = SIG_DD-SIGDD | |
9565 | FAC = SIGLDD/SIGDD | |
9566 | SIGLDD = SIGLDD+FAC*DEL_DD | |
9567 | SIGHDD = SIGHDD+(1.D0-FAC)*DEL_DD | |
9568 | SIGCOR = DEL_SD1 + DEL_SD2 + DEL_DD | |
9569 | ||
9570 | ELSE | |
9571 | ||
9572 | C rescale double diffraction cross sections | |
9573 | SIGLDD = SIGLDD *PARMDL(42) | |
9574 | SIGHDD = SIGHDD *PARMDL(42) | |
9575 | SIGCOR = DEL_SD1 + DEL_SD2 | |
9576 | & +(SIGLDD+SIGHDD)*(PARMDL(42)-1.D0) | |
9577 | ||
9578 | ENDIF | |
9579 | ||
9580 | ELSE | |
9581 | ||
9582 | C rescale unitarized cross sections for diffraction dissociation | |
9583 | ||
9584 | SIGLSD(1) = SIGLSD(1)*PARMDL(40) | |
9585 | SIGHSD(1) = SIGHSD(1)*PARMDL(40) | |
9586 | SIGLSD(2) = SIGLSD(2)*PARMDL(41) | |
9587 | SIGHSD(2) = SIGHSD(2)*PARMDL(41) | |
9588 | SIGLDD = SIGLDD *PARMDL(42) | |
9589 | SIGHDD = SIGHDD *PARMDL(42) | |
9590 | SIGCOR = (SIGLSD(1)+SIGHSD(1))*(PARMDL(40)-1.D0) | |
9591 | & +(SIGLSD(2)+SIGHSD(2))*(PARMDL(41)-1.D0) | |
9592 | & +(SIGLDD+SIGHDD)*(PARMDL(42)-1.D0) | |
9593 | ||
9594 | ENDIF | |
9595 | ||
9596 | C non-diffractive inelastic cross section | |
9597 | ||
9598 | SIGNDF = SIGTOT-SIGELA-SIGVM(0,0)-SIGCDF(0)-SIGDIR | |
9599 | & -SIGLSD(1)-SIGHSD(1)-SIGLSD(2)-SIGHSD(2) | |
9600 | & -SIGLDD-SIGHDD | |
9601 | ||
9602 | C specify elastic scattering channel | |
9603 | ||
9604 | 500 CONTINUE | |
9605 | IF(IFPAP(1).NE.22) THEN | |
9606 | VMESA(1) = PHO_PNAME(IFPAB(1),0) | |
9607 | ELSE | |
9608 | VMESA(1) = 'rho ' | |
9609 | ENDIF | |
9610 | IF(IFPAP(2).NE.22) THEN | |
9611 | VMESB(1) = PHO_PNAME(IFPAB(2),0) | |
9612 | ELSE | |
9613 | VMESB(1) = 'rho ' | |
9614 | ENDIF | |
9615 | ||
9616 | C write out physical cross sections | |
9617 | ||
9618 | IF(IDEB(57).GE.5) THEN | |
9619 | WRITE(LO,'(/1X,A,I3,/1X,A)') | |
9620 | & 'PHO_XSECT: cross sections (mb) for combination',IP, | |
9621 | & '----------------------------------------------' | |
9622 | WRITE(LO,'(5X,A,E12.3,2E11.3)')'energy,virtualities',ECM,PVIRT | |
9623 | WRITE(LO,'(5X,A,E12.3)') ' total ',SIGTOT | |
9624 | WRITE(LO,'(5X,A,E12.3)') ' purely elastic ',SIGELA | |
9625 | WRITE(LO,'(5X,A,E12.3)') ' inelastic ',SIGINE | |
9626 | WRITE(LO,'(5X,A,E12.3)') ' s-diff.particle 1 ', | |
9627 | & SIGLSD(1)+SIGHSD(1) | |
9628 | IF(IDEB(57).GE.7) THEN | |
9629 | WRITE(LO,'(5X,A,E12.3)') ' low-mass part ',SIGLSD(1) | |
9630 | WRITE(LO,'(5X,A,E12.3)') ' high-mass part ',SIGHSD(1) | |
9631 | ENDIF | |
9632 | WRITE(LO,'(5X,A,E12.3)') ' s-diff.particle 2 ', | |
9633 | & SIGLSD(2)+SIGHSD(2) | |
9634 | IF(IDEB(57).GE.7) THEN | |
9635 | WRITE(LO,'(5X,A,E12.3)') ' low-mass part ',SIGLSD(2) | |
9636 | WRITE(LO,'(5X,A,E12.3)') ' high-mass part ',SIGHSD(2) | |
9637 | ENDIF | |
9638 | WRITE(LO,'(5X,A,E12.3)') ' double diff ',SIGLDD+SIGHDD | |
9639 | IF(IDEB(57).GE.7) THEN | |
9640 | WRITE(LO,'(5X,A,E12.3)') ' low-mass part ',SIGLDD | |
9641 | WRITE(LO,'(5X,A,E12.3)') ' high-mass part ',SIGHDD | |
9642 | ENDIF | |
9643 | WRITE(LO,'(5X,A,E12.3)') ' double pomeron ',SIGCDF(0) | |
9644 | IF(IDEB(57).GE.7) THEN | |
9645 | WRITE(LO,'(5X,A,E12.3)') ' purely elastic ',SIGCDF(1) | |
9646 | WRITE(LO,'(5X,A,E12.3)') ' excitation part.1 ',SIGCDF(2) | |
9647 | WRITE(LO,'(5X,A,E12.3)') ' excitation part.2 ',SIGCDF(3) | |
9648 | WRITE(LO,'(5X,A,E12.3)') ' excitation both ',SIGCDF(4) | |
9649 | ENDIF | |
9650 | WRITE(LO,'(5X,A,E12.3)') ' elastic slope ',SLOEL | |
9651 | DO 200 I=1,4 | |
9652 | DO 210 J=1,4 | |
9653 | IF(SIGVM(I,J).GT.DEPS) THEN | |
9654 | WRITE(LO,'(1X,3A)') 'q-elastic production of ', | |
9655 | & VMESA(I),VMESB(J) | |
9656 | WRITE(LO,'(10X,A,E12.3)') 'cross section ',SIGVM(I,J) | |
9657 | IF((I.NE.0).AND.(J.NE.0)) | |
9658 | & WRITE(LO,'(18X,A,E12.3)') 'slope ',SLOVM(I,J) | |
9659 | ENDIF | |
9660 | 210 CONTINUE | |
9661 | 200 CONTINUE | |
9662 | IF(IDEB(57).GE.7) THEN | |
9663 | WRITE(LO,'(5X,A,E12.3)') ' vmeson production ',SIGVM(0,0) | |
9664 | WRITE(LO,'(5X,A,E12.3)') ' one-pomeron soft ',SIG1SO | |
9665 | WRITE(LO,'(5X,A,E12.3)') ' one-pomeron hard ',SIG1HA | |
9666 | WRITE(LO,'(5X,A,E12.3)') ' pomeron exchange ',SIGPOM | |
9667 | WRITE(LO,'(5X,A,E12.3)') ' reggeon exchange ',SIGREG | |
9668 | WRITE(LO,'(5X,A,E12.3)') ' hard resolved QCD ',DREAL(DSIGH(9)) | |
9669 | WRITE(LO,'(5X,A,E12.3/)')' hard direct QCD ', | |
9670 | & DREAL(DSIGH(15)) | |
9671 | ENDIF | |
9672 | ENDIF | |
9673 | ||
9674 | ECM = ETMP | |
9675 | ||
9676 | END | |
9677 | ||
9678 | *$ CREATE PHO_IMPAMP.FOR | |
9679 | *COPY PHO_IMPAMP | |
9680 | CDECK ID>, PHO_IMPAMP | |
9681 | SUBROUTINE PHO_IMPAMP(EE,BMIN,BMAX,NSTEP) | |
9682 | C********************************************************************* | |
9683 | C | |
9684 | C calculation of physical impact parameter amplitude | |
9685 | C | |
9686 | C input: EE cm energy (GeV) | |
9687 | C BMIN lower bound in B | |
9688 | C BMAX upper bound in B | |
9689 | C NSTEP number of values (linear) | |
9690 | C | |
9691 | C output: values written to output unit | |
9692 | C | |
9693 | C********************************************************************* | |
9694 | IMPLICIT DOUBLE PRECISION (A-H,O-Z) | |
9695 | SAVE | |
9696 | ||
9697 | PARAMETER(ONEM=-1.D0, | |
9698 | & THOUS=1.D3, | |
9699 | & DEPS=1.D-20) | |
9700 | ||
9701 | C input/output channels | |
9702 | INTEGER LI,LO | |
9703 | COMMON /POINOU/ LI,LO | |
9704 | C event debugging information | |
9705 | INTEGER NMAXD | |
9706 | PARAMETER (NMAXD=100) | |
9707 | INTEGER IDEB,KSPOM,KHPOM,KSREG,KHDIR,KACCEP,KSTRG,KHTRG,KSLOO, | |
9708 | & KHLOO,KSDPO,KHDPO,KEVENT,KSOFT,KHARD | |
9709 | COMMON /PODEBG/ IDEB(NMAXD),KSPOM,KHPOM,KSREG,KHDIR,KACCEP,KSTRG, | |
9710 | & KHTRG,KSLOO,KHLOO,KSDPO,KHDPO,KEVENT,KSOFT,KHARD | |
9711 | C model switches and parameters | |
9712 | CHARACTER*8 MDLNA | |
9713 | INTEGER ISWMDL,IPAMDL | |
9714 | DOUBLE PRECISION PARMDL | |
9715 | COMMON /POMDLS/ MDLNA(50),ISWMDL(50),PARMDL(400),IPAMDL(400) | |
9716 | C global event kinematics and particle IDs | |
9717 | INTEGER IFPAP,IFPAB | |
9718 | DOUBLE PRECISION ECM,PCM,PMASS,PVIRT | |
9719 | COMMON /POGCMS/ ECM,PCM,PMASS(2),PVIRT(2),IFPAP(2),IFPAB(2) | |
9720 | C complex Born graph amplitudes used for unitarization | |
9721 | COMPLEX*16 AMPEL,AMPVM,AMPSOF,AMPHAR,AMLMSD,AMHMSD,AMLMDD, | |
9722 | & AMHMDD,AMPDP | |
9723 | COMMON /POINT4/ AMPEL,AMPVM(4,4),AMPSOF,AMPHAR,AMLMSD(2), | |
9724 | & AMHMSD(2),AMLMDD,AMHMDD,AMPDP(4) | |
9725 | ||
9726 | ECM=EE | |
9727 | BSTEP = (BMAX-BMIN)/DBLE(NSTEP-1) | |
9728 | C | |
9729 | WRITE(LO,'(3(/,1X,A))') | |
9730 | & 'impact parameter amplitudes:', | |
9731 | & ' B AMP-EL AMP-LMSD(1,2) AMP-HMSD(1,2) AMP-LMDD AMP-HMDD', | |
9732 | & '-------------------------------------------------------------' | |
9733 | C | |
9734 | BB = BMIN | |
9735 | DO 100 I=1,NSTEP | |
9736 | C calculate impact parameter amplitudes | |
9737 | IF(I.EQ.1) THEN | |
9738 | CALL PHO_EIKON(1,-1,BMIN) | |
9739 | ELSE | |
9740 | CALL PHO_EIKON(1,1,BB) | |
9741 | ENDIF | |
9742 | WRITE(LO,'(1X,8E12.4)') BB,DREAL(AMPEL), | |
9743 | & DREAL(AMLMSD(1)),DREAL(AMLMSD(2)), | |
9744 | & DREAL(AMHMSD(1)),DREAL(AMHMSD(2)),DREAL(AMLMDD),DREAL(AMHMDD) | |
9745 | BB = BB+BSTEP | |
9746 | 100 CONTINUE | |
9747 | ||
9748 | END | |
9749 | ||
9750 | *$ CREATE PHO_PRBDIS.FOR | |
9751 | *COPY PHO_PRBDIS | |
9752 | CDECK ID>, PHO_PRBDIS | |
9753 | SUBROUTINE PHO_PRBDIS(IP,ECM,IE) | |
9754 | C********************************************************************* | |
9755 | C | |
9756 | C calculation of multi interactions probabilities | |
9757 | C | |
9758 | C input: IP particle combination to scatter | |
9759 | C ECM CMS energy | |
9760 | C IE index for weight storing | |
9761 | C /PROBAB/ | |
9762 | C IMAX max. number of soft pomeron interactions | |
9763 | C KMAX max. number of hard pomeron interactions | |
9764 | C | |
9765 | C output: /PROBAB/ | |
9766 | C PROB field of probabilities | |
9767 | C | |
9768 | C********************************************************************* | |
9769 | IMPLICIT DOUBLE PRECISION (A-H,O-Z) | |
9770 | SAVE | |
9771 | ||
9772 | PARAMETER ( EPS=1.D-10 ) | |
9773 | ||
9774 | C input/output channels | |
9775 | INTEGER LI,LO | |
9776 | COMMON /POINOU/ LI,LO | |
9777 | C event debugging information | |
9778 | INTEGER NMAXD | |
9779 | PARAMETER (NMAXD=100) | |
9780 | INTEGER IDEB,KSPOM,KHPOM,KSREG,KHDIR,KACCEP,KSTRG,KHTRG,KSLOO, | |
9781 | & KHLOO,KSDPO,KHDPO,KEVENT,KSOFT,KHARD | |
9782 | COMMON /PODEBG/ IDEB(NMAXD),KSPOM,KHPOM,KSREG,KHDIR,KACCEP,KSTRG, | |
9783 | & KHTRG,KSLOO,KHLOO,KSDPO,KHDPO,KEVENT,KSOFT,KHARD | |
9784 | C Reggeon phenomenology parameters | |
9785 | DOUBLE PRECISION ALPOM,ALPOMP,GP,B0POM,ALREG,ALREGP,GR,B0REG, | |
9786 | & GPPP,GPPR,B0PPP,B0PPR,VDMFAC,VDMQ2F,B0HAR,AKFAC | |
9787 | COMMON /POPREG/ ALPOM,ALPOMP,GP(2),B0POM(2), | |
9788 | & ALREG,ALREGP,GR(2),B0REG(2), | |
9789 | & GPPP,GPPR,B0PPP,B0PPR, | |
9790 | & VDMFAC(4),VDMQ2F(4),B0HAR,AKFAC | |
9791 | C parameters of 2x2 channel model | |
9792 | DOUBLE PRECISION PHISUP,RMASS,VAR,AMPFAC,ELAFAC,VFAC | |
9793 | COMMON /PO2CHA/ PHISUP(2),RMASS(2),VAR,AMPFAC(4),ELAFAC(4),VFAC | |
9794 | C Born graph cross sections and slopes | |
9795 | INTEGER Max_pro_3 | |
9796 | PARAMETER ( Max_pro_3 = 16 ) | |
9797 | COMPLEX*16 SIGP,SIGR,SIGHD,SIGHR,SIGT1,SIGT2,SIGL,SIGDP, | |
9798 | & SIGD1,SIGD2,DSIGH | |
9799 | COMMON /POSBRN/ SIGP,SIGR,SIGHD,SIGHR,SIGT1(2),SIGT2(2),SIGL, | |
9800 | & SIGDP(4),SIGD1(2),SIGD2(2),DSIGH(0:Max_pro_3) | |
9801 | C obsolete cut-off information | |
9802 | DOUBLE PRECISION PTCUT,PTANO,FPS,FPH,PSOMIN,XSOMIN | |
9803 | COMMON /POCUT1/ PTCUT(4),PTANO(4),FPS(4),FPH(4),PSOMIN,XSOMIN | |
9804 | C Born graph cross sections after applying diffraction model | |
9805 | DOUBLE PRECISION SBOPOM,SBOREG,SBOHAR,SBOHAD,SBOTR1,SBOTR2, | |
9806 | & SBOLPO,SBODPO | |
9807 | COMMON /POINT1/ SBOPOM(0:4),SBOREG(0:4),SBOHAR(0:4),SBOHAD(0:4), | |
9808 | & SBOTR1(0:4,2),SBOTR2(0:4,2),SBOLPO(0:4), | |
9809 | & SBODPO(0:4,4) | |
9810 | C cross sections | |
9811 | INTEGER IPFIL,IFAFIL,IFBFIL | |
9812 | DOUBLE PRECISION SIGTOT,SIGELA,SIGVM,SIGINE,SIGNDF,SIGDIR, | |
9813 | & SIGLSD,SIGHSD,SIGLDD,SIGHDD,SIGCDF, | |
9814 | & SIGPOM,SIGREG,SIGHAR,SIGTR1,SIGTR2,SIGLOO, | |
9815 | & SIGDPO,SIG1SO,SIG1HA,SLOEL,SLOVM,SIGCOR, | |
9816 | & FSUP,FSUD,FSUH,ECMFIL,P2AFIL,P2BFIL | |
9817 | COMMON /POCSEC/ SIGTOT,SIGELA,SIGVM(0:4,0:4),SIGINE,SIGNDF,SIGDIR, | |
9818 | & SIGLSD(2),SIGHSD(2),SIGLDD,SIGHDD,SIGCDF(0:4), | |
9819 | & SIGPOM,SIGREG,SIGHAR,SIGTR1(2),SIGTR2(2),SIGLOO, | |
9820 | & SIGDPO(4),SIG1SO,SIG1HA,SLOEL,SLOVM(4,4),SIGCOR, | |
9821 | & FSUP(2),FSUD(2),FSUH(2),ECMFIL,P2AFIL,P2BFIL, | |
9822 | & IPFIL,IFAFIL,IFBFIL | |
9823 | C cut probability distribution | |
9824 | INTEGER IEETA1,IIMAX,KKMAX | |
9825 | PARAMETER( IEETA1=20, IIMAX=20, KKMAX=20 ) | |
9826 | INTEGER IEEMAX,IMAX,KMAX | |
9827 | REAL PROB | |
9828 | DOUBLE PRECISION EPTAB | |
9829 | COMMON /POPROB/ PROB(4,IEETA1,0:IIMAX,0:KKMAX),EPTAB(4,IEETA1), | |
9830 | & IEEMAX,IMAX,KMAX | |
9831 | C energy-interpolation table | |
9832 | INTEGER IEETA2 | |
9833 | PARAMETER ( IEETA2 = 20 ) | |
9834 | INTEGER ISIMAX | |
9835 | DOUBLE PRECISION SIGTAB,SIGECM | |
9836 | COMMON /POTABL/ SIGTAB(4,80,IEETA2),SIGECM(4,IEETA2),ISIMAX | |
9837 | C average number of cut soft and hard ladders (obsolete) | |
9838 | DOUBLE PRECISION AVERI,AVERK,AVERL,AVERM,AVERN | |
9839 | COMMON /POINT2/ AVERI,AVERK,AVERL,AVERM,AVERN | |
9840 | C some constants | |
9841 | DOUBLE PRECISION PI,PI2,PI4,GEV2MB,Q_ch,Q_ch2,Q_ch4 | |
9842 | COMMON /POCONS/ PI,PI2,PI4,GEV2MB, | |
9843 | & Q_ch(-6:6),Q_ch2(-6:6),Q_ch4(-6:6) | |
9844 | C integration precision for hard cross sections (obsolete) | |
9845 | INTEGER NGAUP1,NGAUP2,NGAUET,NGAUIN,NGAUSO | |
9846 | COMMON /POGAUP/ NGAUP1,NGAUP2,NGAUET,NGAUIN,NGAUSO | |
9847 | C model switches and parameters | |
9848 | CHARACTER*8 MDLNA | |
9849 | INTEGER ISWMDL,IPAMDL | |
9850 | DOUBLE PRECISION PARMDL | |
9851 | COMMON /POMDLS/ MDLNA(50),ISWMDL(50),PARMDL(400),IPAMDL(400) | |
9852 | C unitarized amplitudes for different diffraction channels | |
9853 | DOUBLE PRECISION ZXP,BXP,ZXR,BXR,ZXH,BXH,ZXD,BXD, | |
9854 | & ZXT1A,BXT1A,ZXT1B,BXT1B,ZXT2A,BXT2A,ZXT2B,BXT2B, | |
9855 | & ZXDPE,BXDPE,ZXDPA,BXDPA,ZXDPB,BXDPB,ZXDPD,BXDPD, | |
9856 | & ZXL,BXL | |
9857 | COMMON /POINT5/ ZXP(4,4),BXP(4,4),ZXR(4,4),BXR(4,4), | |
9858 | & ZXH(4,4),BXH(4,4),ZXD(4,4),BXD(4,4), | |
9859 | & ZXT1A(4,4),BXT1A(4,4),ZXT1B(4,4),BXT1B(4,4), | |
9860 | & ZXT2A(4,4),BXT2A(4,4),ZXT2B(4,4),BXT2B(4,4), | |
9861 | & ZXDPE(4,4),BXDPE(4,4),ZXDPA(4,4),BXDPA(4,4), | |
9862 | & ZXDPB(4,4),BXDPB(4,4),ZXDPD(4,4),BXDPD(4,4), | |
9863 | & ZXL(4,4),BXL(4,4) | |
9864 | ||
9865 | C local variables | |
9866 | DIMENSION AB(4,4),CHI2(4),ABSUM2(4,4),ABSTMP(4),CHITMP(4) | |
9867 | PARAMETER (ICHMAX=40) | |
9868 | DIMENSION CHIFAC(4,4),AMPCOF(4) | |
9869 | DIMENSION PCHAIN(2,ICHMAX),XPNT(96),WGHT(96) | |
9870 | DIMENSION FACLOG(0:30),PSOFT(0:30),PHARD(0:30) | |
9871 | ||
9872 | C combinatorical factors | |
9873 | DATA CHIFAC / 1.D0, 1.D0,-1.D0,-1.D0, | |
9874 | & 1.D0,-1.D0, 1.D0,-1.D0, | |
9875 | & 1.D0,-1.D0,-1.D0, 1.D0, | |
9876 | & 1.D0, 1.D0, 1.D0, 1.D0 / | |
9877 | ||
9878 | DATA FACLOG / .000000000000000D+00, | |
9879 | & .000000000000000D+00, .693147180559945D+00, | |
9880 | & .109861228866811D+01, .138629436111989D+01, | |
9881 | & .160943791243410D+01, .179175946922805D+01, | |
9882 | & .194591014905531D+01, .207944154167984D+01, | |
9883 | & .219722457733622D+01, .230258509299405D+01, | |
9884 | & .239789527279837D+01, .248490664978800D+01, | |
9885 | & .256494935746154D+01, .263905732961526D+01, | |
9886 | & .270805020110221D+01, .277258872223978D+01, | |
9887 | & .283321334405622D+01, .289037175789616D+01, | |
9888 | & .294443897916644D+01, .299573227355399D+01, | |
9889 | & .304452243772342D+01, .309104245335832D+01, | |
9890 | & .313549421592915D+01, .317805383034795D+01, | |
9891 | & .321887582486820D+01, .325809653802148D+01, | |
9892 | & .329583686600433D+01, .333220451017520D+01, | |
9893 | & .336729582998647D+01, .340119738166216D+01 / | |
9894 | ||
9895 | DATA ELAST / 0.D0 / | |
9896 | DATA IPLAST / 0 / | |
9897 | ||
9898 | C test for redundant calculation: skip cs calculation | |
9899 | IF((ECM.NE.ELAST).OR.(IP.NE.IPLAST)) THEN | |
9900 | ELAST = ECM | |
9901 | IPLAST = IP | |
9902 | CALL PHO_XSECT(IP,0,ELAST) | |
9903 | ISIMAX = IE | |
9904 | SIGECM(IP,IE) = ECM | |
9905 | SIGTAB(IP,1,IE) = SIGTOT | |
9906 | SIGTAB(IP,2,IE) = SIGELA | |
9907 | J = 2 | |
9908 | DO 5 I=0,4 | |
9909 | DO 6 K=0,4 | |
9910 | J = J+1 | |
9911 | SIGTAB(IP,J,IE) = SIGVM(I,K) | |
9912 | 6 CONTINUE | |
9913 | 5 CONTINUE | |
9914 | SIGTAB(IP,28,IE) = SIGINE | |
9915 | SIGTAB(IP,29,IE) = SIGDIR | |
9916 | SIGTAB(IP,30,IE) = SIGLSD(1) | |
9917 | SIGTAB(IP,31,IE) = SIGLSD(2) | |
9918 | SIGTAB(IP,32,IE) = SIGHSD(1) | |
9919 | SIGTAB(IP,33,IE) = SIGHSD(2) | |
9920 | SIGTAB(IP,34,IE) = SIGLDD | |
9921 | SIGTAB(IP,35,IE) = SIGHDD | |
9922 | SIGTAB(IP,36,IE) = SIGCDF(0) | |
9923 | SIGTAB(IP,37,IE) = SIG1SO | |
9924 | SIGTAB(IP,38,IE) = SIG1HA | |
9925 | SIGTAB(IP,39,IE) = SLOEL | |
9926 | J = 39 | |
9927 | DO 7 I=1,4 | |
9928 | DO 8 K=1,4 | |
9929 | J = J+1 | |
9930 | SIGTAB(IP,J,IE) = SLOVM(I,K) | |
9931 | 8 CONTINUE | |
9932 | 7 CONTINUE | |
9933 | SIGTAB(IP,56,IE) = SIGPOM | |
9934 | SIGTAB(IP,57,IE) = SIGREG | |
9935 | SIGTAB(IP,58,IE) = SIGHAR | |
9936 | SIGTAB(IP,59,IE) = SIGDIR | |
9937 | SIGTAB(IP,60,IE) = SIGTR1(1) | |
9938 | SIGTAB(IP,61,IE) = SIGTR1(2) | |
9939 | SIGTAB(IP,62,IE) = SIGTR2(1) | |
9940 | SIGTAB(IP,63,IE) = SIGTR2(2) | |
9941 | SIGTAB(IP,64,IE) = SIGLOO | |
9942 | SIGTAB(IP,65,IE) = SIGDPO(1) | |
9943 | SIGTAB(IP,66,IE) = SIGDPO(2) | |
9944 | SIGTAB(IP,67,IE) = SIGDPO(3) | |
9945 | SIGTAB(IP,68,IE) = SIGDPO(4) | |
9946 | ||
9947 | C consistency check | |
9948 | SIGNDF = SIGTOT-SIGELA-SIGVM(0,0)-SIGCDF(0)-SIGDIR | |
9949 | & -SIGLSD(1)-SIGHSD(1)-SIGLSD(2)-SIGHSD(2) | |
9950 | & -SIGLDD-SIGHDD | |
9951 | ||
9952 | IF(SIGNDF.LE.0.D0) THEN | |
9953 | WRITE(LO,'(//1X,A,/)') | |
9954 | & 'PHO_PRBDIS:ERROR: neg.cross section for unitarization!' | |
9955 | WRITE(LO,'(1X,A,I3,1P,2E12.4)') | |
9956 | & 'PHO_PRBDIS: IP,ECM,SIGNDF:',IP,ECM,SIGNDF | |
9957 | WRITE(LO,'(4X,A,/1P,8E10.3)') | |
9958 | &'(SIGTOT,SIGELA,SIGVM,SIGCDF,SIGDIR,SIGLSD(1),SIGLSD(2),SIGLDD):', | |
9959 | & SIGTOT,SIGELA,SIGVM(0,0),SIGCDF(0),SIGDIR,SIGLSD(1), | |
9960 | & SIGLSD(2),SIGLDD | |
9961 | STOP | |
9962 | ENDIF | |
9963 | ||
9964 | IF((IDEB(55).GE.2).AND.(IP.EQ.1)) THEN | |
ecf67adb | 9965 | WRITE(LO,*) '------------------------------------------------' |
9966 | WRITE(LO,*) 'IP,ECM:',IP,ECM | |
9967 | WRITE(LO,*) 'SIGTOT:',SIGTOT | |
9968 | WRITE(LO,*) 'SIGELA:',SIGELA | |
9969 | WRITE(LO,*) 'SIGVM :',SIGVM(0,0) | |
9970 | WRITE(LO,*) 'SIGCDF:',SIGCDF(0) | |
9971 | WRITE(LO,*) 'SIGDIR:',SIGDIR | |
9972 | WRITE(LO,*) 'SIGLSD:',SIGLSD | |
9973 | WRITE(LO,*) 'SIGHSD:',SIGHSD | |
9974 | WRITE(LO,*) 'SIGLDD:',SIGLDD | |
9975 | WRITE(LO,*) 'SIGHDD:',SIGHDD | |
9976 | WRITE(LO,*) 'SIGNDF:',SIGNDF | |
9977 | ||
9978 | WRITE(LO,*) 'SIGPOM:',SIGPOM | |
9979 | WRITE(LO,*) 'SIGREG:',SIGREG | |
9980 | WRITE(LO,*) 'SIGHAR:',SIGHAR | |
9981 | WRITE(LO,*) 'SIGDIR:',SIGDIR | |
9982 | WRITE(LO,*) 'SIGTR1:',SIGTR1 | |
9983 | WRITE(LO,*) 'SIGTR2:',SIGTR2 | |
9984 | WRITE(LO,*) 'SIGLOO:',SIGLOO | |
9985 | WRITE(LO,*) 'SIGDPO:',SIGDPO | |
9986 | WRITE(LO,*) 'SIG1SO:',SIG1SO | |
9987 | WRITE(LO,*) 'SIG1HA:',SIG1HA | |
9aaba0d6 | 9988 | ENDIF |
9989 | ||
9990 | SIGTAB(IP,77,IE) = PTCUT(IP) | |
9991 | SIGTAB(IP,78,IE) = SIGNDF | |
9992 | ||
9993 | AUXFAC = PI2/SIGNDF | |
9994 | IF(ISWMDL(1).EQ.3) THEN | |
9995 | DO 133 I=1,4 | |
9996 | AMPCOF(I) = 0.D0 | |
9997 | DO 135 K=1,4 | |
9998 | AMPCOF(I) = AMPCOF(I) + 0.25D0*ELAFAC(K)*CHIFAC(K,I) | |
9999 | 135 CONTINUE | |
10000 | AMPCOF(I) = AMPCOF(I)*AUXFAC | |
10001 | 133 CONTINUE | |
10002 | ENDIF | |
10003 | C | |
10004 | * BMAX=5.D0*SQRT(DBLE(BPOM)) | |
10005 | BMAX=10.D0 | |
10006 | EPTAB(IP,IE) = ECM | |
10007 | CALL PHO_GAUSET(0.D0,BMAX,NGAUSO,XPNT,WGHT) | |
10008 | C | |
10009 | ENDIF | |
10010 | C | |
10011 | DO 160 K=0,KMAX | |
10012 | DO 170 I=0,IMAX | |
10013 | PROB(IP,IE,I,K) = 0.D0 | |
10014 | 170 CONTINUE | |
10015 | 160 CONTINUE | |
10016 | DO 120 I=1,ICHMAX | |
10017 | PCHAIN(1,I) = 0.D0 | |
10018 | PCHAIN(2,I) = 0.D0 | |
10019 | 120 CONTINUE | |
10020 | C | |
10021 | C main cross section loop | |
10022 | C********************************************************** | |
10023 | DO 5000 IB=1,NGAUSO | |
10024 | B24=XPNT(IB)**2/4.D0 | |
10025 | FAC = XPNT(IB)*WGHT(IB) | |
10026 | C | |
10027 | IF((ISWMDL(1).EQ.3).OR.(ISWMDL(1).EQ.4)) THEN | |
10028 | C | |
10029 | C amplitude construction | |
10030 | DO 525 I=1,4 | |
10031 | AB(1,I)=ZXP(1,I)*EXP(-B24/BXP(1,I)) | |
10032 | & +ZXR(1,I)*EXP(-B24/BXR(1,I)) | |
10033 | AB(2,I)=ZXH(1,I)*EXP(-B24/BXH(1,I)) | |
10034 | AB(3,I)=-ZXT1A(1,I)*EXP(-B24/BXT1A(1,I)) | |
10035 | & -ZXT1B(1,I)*EXP(-B24/BXT1B(1,I)) | |
10036 | & -ZXT2A(1,I)*EXP(-B24/BXT2A(1,I)) | |
10037 | & -ZXT2B(1,I)*EXP(-B24/BXT2B(1,I)) | |
10038 | & -ZXL(1,I)*EXP(-B24/BXL(1,I)) | |
10039 | AB(4,I)=ZXDPE(1,I)*EXP(-B24/BXDPE(1,I)) | |
10040 | & +ZXDPA(1,I)*EXP(-B24/BXDPA(1,I)) | |
10041 | & +ZXDPB(1,I)*EXP(-B24/BXDPB(1,I)) | |
10042 | & +ZXDPD(1,I)*EXP(-B24/BXDPD(1,I)) | |
10043 | AB(1,I) = AB(1,I)+AB(3,I)+AB(4,I) | |
10044 | AB(2,I) = AB(2,I) | |
10045 | AB(3,I) = 0.D0 | |
10046 | AB(4,I) = 0.D0 | |
10047 | * | |
10048 | 525 CONTINUE | |
10049 | C | |
10050 | DO 460 I=1,4 | |
10051 | DO 500 K=1,4 | |
10052 | ABSUM2(I,K) = 0.D0 | |
10053 | DO 550 L=1,4 | |
10054 | ABSUM2(I,K) = ABSUM2(I,K) + CHIFAC(L,K)*AB(I,L) | |
10055 | 550 CONTINUE | |
10056 | ABSUM2(I,K) = 2.D0*ABSUM2(I,K) | |
10057 | 500 CONTINUE | |
10058 | 460 CONTINUE | |
10059 | DO 600 I=1,4 | |
10060 | CHI2(I) = 0.D0 | |
10061 | DO 650 K=1,4 | |
10062 | CHI2(I) = CHI2(I) + ABSUM2(K,I) | |
10063 | 650 CONTINUE | |
10064 | 600 CONTINUE | |
10065 | C sums instead of products | |
10066 | DO 660 I=1,4 | |
10067 | DO 670 KD=1,4 | |
10068 | DTMP = ABS(ABSUM2(I,KD)) | |
10069 | IF(DTMP.LT.1.D-30) THEN | |
10070 | ABSUM2(I,KD) = -50.D0 | |
10071 | ELSE | |
10072 | ABSUM2(I,KD) = LOG(DTMP) | |
10073 | ENDIF | |
10074 | 670 CONTINUE | |
10075 | 660 CONTINUE | |
10076 | ||
10077 | IF(MAX(IMAX,KMAX).GT.30) THEN | |
10078 | WRITE(LO,'(1X,2A,3I6)') 'PHO_PRBDIS: internal field ', | |
10079 | & 'dimension too small (IMAX,KMAX,int):',IMAX,KMAX,30 | |
10080 | CALL PHO_ABORT | |
10081 | ENDIF | |
10082 | DO 700 KD=1,4 | |
10083 | DO 750 I=1,4 | |
10084 | ABSTMP(I) = ABSUM2(I,KD) | |
10085 | 750 CONTINUE | |
10086 | C recursive sum | |
10087 | CHITMP(1) = -ABSUM2(1,KD) | |
10088 | DO 800 I=0,IMAX | |
10089 | CHITMP(1) = CHITMP(1)+ABSTMP(1)-FACLOG(I) | |
10090 | CHITMP(2) = -ABSTMP(2) | |
10091 | DO 810 K=0,KMAX | |
10092 | CHITMP(2) = CHITMP(2)+ABSTMP(2)-FACLOG(K) | |
10093 | C calculation of elastic part | |
10094 | DTMP = -CHI2(KD)+CHITMP(1)+CHITMP(2) | |
10095 | IF(DTMP.LT.-30.D0) THEN | |
10096 | DTMP = 0.D0 | |
10097 | ELSE | |
10098 | DTMP = EXP(DTMP)*FAC*AMPCOF(KD) | |
10099 | ENDIF | |
10100 | PROB(IP,IE,I,K) = PROB(IP,IE,I,K) + DTMP | |
10101 | 810 CONTINUE | |
10102 | 800 CONTINUE | |
10103 | 700 CONTINUE | |
10104 | PROB(IP,IE,0,0) = 0.D0 | |
10105 | C | |
10106 | C********************************************************** | |
10107 | ELSE | |
10108 | WRITE(LO,'(1X,A,I3)') | |
10109 | & 'PHO_PRBDIS:ERROR: invalid setting of ISWMDL(1)',ISWMDL(1) | |
10110 | STOP | |
10111 | ENDIF | |
10112 | 5000 CONTINUE | |
10113 | ||
10114 | C debug output | |
10115 | IF(IDEB(55).GE.15) THEN | |
10116 | WRITE(LO,'(/,1X,A,I3,E11.4)') | |
10117 | & 'PHO_PRBDIS: list of probabilities (uncorrected,IP,ECM)', | |
10118 | & IP,ECM | |
10119 | DO 905 I=0,MIN(IMAX,5) | |
10120 | DO 915 K=0,MIN(KMAX,5) | |
10121 | IF(ABS(PROB(IP,IE,I,K)).GT.1.D-10) | |
10122 | & WRITE(LO,'(10X,2I3,5X,E12.3)') I,K,PROB(IP,IE,I,K) | |
10123 | 915 CONTINUE | |
10124 | 905 CONTINUE | |
10125 | ENDIF | |
10126 | C string probability (uncorrected) | |
10127 | IF(IDEB(55).GE.5) THEN | |
10128 | DO 955 I=0,IMAX | |
10129 | DO 965 K=0,KMAX | |
10130 | INDX = 2*I+2*K | |
10131 | IF((INDX.LE.ICHMAX).AND.(INDX.GT.0)) THEN | |
10132 | PCHAIN(1,INDX) = PCHAIN(1,INDX) + PROB(IP,IE,I,K) | |
10133 | ENDIF | |
10134 | 965 CONTINUE | |
10135 | 955 CONTINUE | |
10136 | WRITE(LO,'(/1X,2A,E11.4)') 'PHO_PRBDIS: ', | |
10137 | & 'list of selected probabilities (uncorr,ECM)',ECM | |
10138 | WRITE(LO,'(10X,A)') 'I, 0HPOM, 1HPOM, 2HPOM' | |
10139 | DO 183 I=0,IIMAX | |
10140 | IF(ABS(PROB(IP,IE,I,0)).GT.1.D-10) | |
10141 | & WRITE(LO,'(5X,I4,3E12.4)') I,PROB(IP,IE,I,0), | |
10142 | & PROB(IP,IE,I,1),PROB(IP,IE,I,2) | |
10143 | 183 CONTINUE | |
10144 | ENDIF | |
10145 | C substract high-mass single and double diffraction | |
10146 | PROB(IP,IE,1,0) = PROB(IP,IE,1,0) | |
10147 | & -(SIGHSD(1)+SIGHSD(2)+SIGHDD+SIGCDF(0))/SIGNDF | |
10148 | PROB(IP,IE,1,0) = MAX(0.01,PROB(IP,IE,1,0)) | |
10149 | C | |
10150 | C probability check | |
10151 | CHKSUM = 0.D0 | |
10152 | PRONEG = 0.D0 | |
10153 | AVERI = 0.D0 | |
10154 | AVERK = 0.D0 | |
10155 | AVERL = 0.D0 | |
10156 | AVERM = 0.D0 | |
10157 | AVERN = 0.D0 | |
10158 | SIGMI = 0.D0 | |
10159 | SIGMK = 0.D0 | |
10160 | SIGML = 0.D0 | |
10161 | SIGMM = 0.D0 | |
10162 | DO 1001 I=0,IMAX | |
10163 | PSOFT(I) = 0.D0 | |
10164 | 1001 CONTINUE | |
10165 | DO 1002 K=0,KMAX | |
10166 | PHARD(K) = 0.D0 | |
10167 | 1002 CONTINUE | |
10168 | DO 1000 K=0,KMAX | |
10169 | DO 1010 I=0,IMAX | |
10170 | TMP = PROB(IP,IE,I,K) | |
10171 | IF(TMP.LT.0.D0) THEN | |
10172 | IF((IDEB(55).GE.0).AND.(TMP.LT.-EPS)) THEN | |
10173 | WRITE(LO,'(1X,A,4I4,E14.4)') | |
10174 | & 'PHO_PRBDIS: neg.probability:', | |
10175 | & IP,IE,I,K,PROB(IP,IE,I,K) | |
10176 | ENDIF | |
10177 | PRONEG = PRONEG+TMP | |
10178 | TMP = 0.D0 | |
10179 | ENDIF | |
10180 | CHKSUM = CHKSUM+TMP | |
10181 | AVERI = AVERI+DBLE(I)*TMP | |
10182 | AVERK = AVERK+DBLE(K)*TMP | |
10183 | SIGMI = SIGMI+DBLE(I**2)*TMP | |
10184 | SIGMK = SIGMK+DBLE(K**2)*TMP | |
10185 | PSOFT(I) = PSOFT(I)+PROB(IP,IE,I,K) | |
10186 | PHARD(K) = PHARD(K)+PROB(IP,IE,I,K) | |
10187 | PROB(IP,IE,I,K) = CHKSUM | |
10188 | 1010 CONTINUE | |
10189 | 1000 CONTINUE | |
10190 | C | |
10191 | IF(IDEB(55).GE.1) WRITE(LO,'(/,1X,A,2E15.6)') | |
10192 | & 'PHO_PRBDIS: first sum of probabilities',CHKSUM,PRONEG | |
10193 | C cut probabilites output | |
10194 | IF(IDEB(55).GE.5) THEN | |
10195 | WRITE(LO,'(/1X,A)') 'list of cut probabilities (uncorr/corr)' | |
10196 | DO 185 I=1,ICHMAX | |
10197 | IF(ABS(PCHAIN(1,I)).GT.1.D-10) | |
10198 | & WRITE(LO,'(5X,I4,2E12.3)') I,PCHAIN(1,I),PCHAIN(1,I)/CHKSUM | |
10199 | 185 CONTINUE | |
10200 | ENDIF | |
10201 | C rescaling necessary | |
10202 | IF(ABS(CHKSUM-1.D0).GT.1.D-15) THEN | |
10203 | FAC = 1.D0/CHKSUM | |
10204 | IF(IDEB(55).GE.1) WRITE(LO,'(/,1X,A,E15.6)') | |
10205 | & 'PHO_PRBDIS: rescaling of probabilities with factor',FAC | |
10206 | DO 40 K=0,KMAX | |
10207 | DO 50 I=0,IMAX | |
10208 | PROB(IP,IE,I,K) = PROB(IP,IE,I,K)*FAC | |
10209 | 50 CONTINUE | |
10210 | 40 CONTINUE | |
10211 | AVERI = AVERI*FAC | |
10212 | AVERK = AVERK*FAC | |
10213 | AVERL = AVERL*FAC | |
10214 | AVERM = AVERM*FAC | |
10215 | SIGMI = SIGMI*FAC**2 | |
10216 | SIGMK = SIGMK*FAC**2 | |
10217 | SIGML = SIGML*FAC**2 | |
10218 | SIGMM = SIGMM*FAC**2 | |
10219 | ENDIF | |
10220 | C | |
10221 | C probability to find Reggeon/Pomeron | |
10222 | PROB(IP,IE,0,0) = -SIGREG/(SIGPOM+SIGREG) | |
10223 | AVERJ = -PROB(IP,IE,0,0)*AVERI | |
10224 | AVERII = AVERI-AVERJ | |
10225 | C | |
10226 | SIGTAB(IP,74,IE) = AVERII | |
10227 | SIGTAB(IP,75,IE) = AVERK | |
10228 | SIGTAB(IP,76,IE) = AVERJ | |
10229 | C | |
10230 | SIGTAB(IP,79,IE) = PROB(IP,IE,IMAX,0)*SIGNDF | |
10231 | SIGTAB(IP,80,IE) = SIGNDF-SIGTAB(IP,79,IE) | |
10232 | C | |
10233 | IF(IDEB(55).GE.1) THEN | |
10234 | ||
10235 | C average interaction probabilities | |
10236 | WRITE(LO,'(/1X,A,/1X,A)') | |
10237 | & 'PHO_PRBDIS: expected interaction statistics', | |
10238 | & '-------------------------------------------' | |
10239 | WRITE(LO,'(1X,A,E12.4,2I3)') | |
10240 | & 'energy,IP,table index:',EPTAB(IP,IE),IP,IE | |
10241 | WRITE(LO,'(1X,A,2I4)') 'current limitations (soft,hard):', | |
10242 | & IMAX,KMAX | |
10243 | WRITE(LO,'(1X,A,E12.4/,4X,A,/,1X,6E11.3)') | |
10244 | & 'averaged number of cuts per event (eff. cs):',SIGNDF, | |
10245 | & ' (Pom / Pom-h / Reg / enh-tri-loop / enh-dble / sum):', | |
10246 | & AVERII,AVERK,AVERJ,AVERL,AVERM, | |
10247 | & AVERI+AVERK+AVERL+AVERM | |
10248 | WRITE(LO,'(1X,A,/,4X,A,/,1X,4E11.3)') | |
10249 | & 'standard deviation ( sqrt(sigma) ):', | |
10250 | & ' (Pomeron / Pomeron-h / enh-tri-loop / enh-dble):', | |
10251 | & SQRT(ABS(SIGMI-AVERI**2)),SQRT(ABS(SIGMK-AVERK**2)), | |
10252 | & SQRT(ABS(SIGML-AVERL**2)),SQRT(ABS(SIGMM-AVERM**2)) | |
10253 | WRITE(LO,'(1X,A)') 'cross section / probability soft, hard' | |
10254 | DO I=0,MIN(IMAX,KMAX) | |
10255 | WRITE(LO,'(I5,2E12.4,3X,2E12.4)') | |
10256 | & I,PSOFT(I)*SIGNDF,PSOFT(I),PHARD(I)*SIGNDF,PHARD(I) | |
10257 | ENDDO | |
10258 | ||
10259 | C cross check of probability distribution and inclusive cross section | |
10260 | PSsum_1 = 0.D0 | |
10261 | PSsum_2 = 0.D0 | |
10262 | PHsum_1 = 0.D0 | |
10263 | PHsum_2 = 0.D0 | |
10264 | do i=1,IMAX | |
10265 | PSsum_1 = PSsum_1+PSOFT(i)*FAC | |
10266 | PSsum_2 = PSsum_2+PSOFT(i)*FAC*dble(i) | |
10267 | enddo | |
10268 | do k=1,KMAX | |
10269 | PHsum_1 = PHsum_1+PHARD(k) | |
10270 | PHsum_2 = PHsum_2+PHARD(k)*FAC*dble(k) | |
10271 | enddo | |
10272 | WRITE(LO,'(1x,a,2E12.4,3X,2E12.4)') 'sum:', | |
10273 | & PSsum_2*SIGNDF,PSsum_1,PHsum_2*SIGNDF,PHsum_1 | |
10274 | ||
10275 | ENDIF | |
10276 | ||
10277 | END | |
10278 | ||
10279 | *$ CREATE PHO_SAMPRO.FOR | |
10280 | *COPY PHO_SAMPRO | |
10281 | CDECK ID>, PHO_SAMPRO | |
10282 | SUBROUTINE PHO_SAMPRO(IP,IFP1,IFP2,ECM,PVIR1,PVIR2,SPROB,IPROC) | |
10283 | C*********************************************************************** | |
10284 | C | |
10285 | C routine to sample kind of process | |
10286 | C | |
10287 | C input: IP particle combination | |
10288 | C IFP1/2 PDG number of particle 1/2 | |
10289 | C ECM c.m. energy (GeV) | |
10290 | C PVIR1/2 virtuality of particle 1/2 (GeV**2, positive) | |
10291 | C SPROB suppression factor for processes 1-7 | |
10292 | C due to rapidity gap survival probability | |
10293 | C IPROC mode | |
10294 | C -2 output of statistics | |
10295 | C -1 initialization | |
10296 | C 0 sampling of process | |
10297 | C | |
10298 | C output: IPROC kind of interaction process: | |
10299 | C 1 non-diffractive resolved process | |
10300 | C 2 elastic scattering | |
10301 | C 3 quasi-elastic rho/omega/phi production | |
10302 | C 4 central diffraction | |
10303 | C 5 single diffraction according to IDIFF1 | |
10304 | C 6 single diffraction according to IDIFF2 | |
10305 | C 7 double diffraction | |
10306 | C 8 single-resolved / direct processes | |
10307 | C | |
10308 | C*********************************************************************** | |
10309 | IMPLICIT NONE | |
10310 | SAVE | |
10311 | ||
10312 | INTEGER IP,IFP1,IFP2,IPROC | |
10313 | DOUBLE PRECISION ECM,PVIR1,PVIR2,SPROB | |
10314 | ||
10315 | C input/output channels | |
10316 | INTEGER LI,LO | |
10317 | COMMON /POINOU/ LI,LO | |
10318 | C event debugging information | |
10319 | INTEGER NMAXD | |
10320 | PARAMETER (NMAXD=100) | |
10321 | INTEGER IDEB,KSPOM,KHPOM,KSREG,KHDIR,KACCEP,KSTRG,KHTRG,KSLOO, | |
10322 | & KHLOO,KSDPO,KHDPO,KEVENT,KSOFT,KHARD | |
10323 | COMMON /PODEBG/ IDEB(NMAXD),KSPOM,KHPOM,KSREG,KHDIR,KACCEP,KSTRG, | |
10324 | & KHTRG,KSLOO,KHLOO,KSDPO,KHDPO,KEVENT,KSOFT,KHARD | |
10325 | C cross sections | |
10326 | INTEGER IPFIL,IFAFIL,IFBFIL | |
10327 | DOUBLE PRECISION SIGTOT,SIGELA,SIGVM,SIGINE,SIGNDF,SIGDIR, | |
10328 | & SIGLSD,SIGHSD,SIGLDD,SIGHDD,SIGCDF, | |
10329 | & SIGPOM,SIGREG,SIGHAR,SIGTR1,SIGTR2,SIGLOO, | |
10330 | & SIGDPO,SIG1SO,SIG1HA,SLOEL,SLOVM,SIGCOR, | |
10331 | & FSUP,FSUD,FSUH,ECMFIL,P2AFIL,P2BFIL | |
10332 | COMMON /POCSEC/ SIGTOT,SIGELA,SIGVM(0:4,0:4),SIGINE,SIGNDF,SIGDIR, | |
10333 | & SIGLSD(2),SIGHSD(2),SIGLDD,SIGHDD,SIGCDF(0:4), | |
10334 | & SIGPOM,SIGREG,SIGHAR,SIGTR1(2),SIGTR2(2),SIGLOO, | |
10335 | & SIGDPO(4),SIG1SO,SIG1HA,SLOEL,SLOVM(4,4),SIGCOR, | |
10336 | & FSUP(2),FSUD(2),FSUH(2),ECMFIL,P2AFIL,P2BFIL, | |
10337 | & IPFIL,IFAFIL,IFBFIL | |
10338 | C model switches and parameters | |
10339 | CHARACTER*8 MDLNA | |
10340 | INTEGER ISWMDL,IPAMDL | |
10341 | DOUBLE PRECISION PARMDL | |
10342 | COMMON /POMDLS/ MDLNA(50),ISWMDL(50),PARMDL(400),IPAMDL(400) | |
10343 | C general process information | |
10344 | INTEGER IPROCE,IDNODF,IDIFR1,IDIFR2,IDDPOM,IPRON | |
10345 | COMMON /POPRCS/ IPROCE,IDNODF,IDIFR1,IDIFR2,IDDPOM,IPRON(15,4) | |
10346 | C event weights and generated cross section | |
10347 | INTEGER IPOWGC,ISWCUT,IVWGHT | |
10348 | DOUBLE PRECISION SIGGEN,HSWGHT,HSWCUT,EVWGHT | |
10349 | COMMON /POWGHT/ SIGGEN(4),HSWGHT(0:10),HSWCUT(20),EVWGHT(0:10), | |
10350 | & IPOWGC(0:10),ISWCUT(20),IVWGHT(0:10) | |
10351 | ||
10352 | DOUBLE PRECISION PRO,XPROB,SIGSDI,CALLS,SIGSUM,ECMSUM | |
10353 | DIMENSION PRO(8,4),XPROB(8),SIGSDI(2) | |
10354 | DIMENSION CALLS(4),SIGSUM(4),ECMSUM(4) | |
10355 | ||
10356 | INTEGER I,K,KMAX | |
10357 | DOUBLE PRECISION DT_RNDM | |
10358 | DOUBLE PRECISION SIGDDI,SIGHD,SIGHR,SIGNDR,XI | |
10359 | ||
10360 | IF(IDEB(11).GE.15) WRITE(LO,'(/,1X,A,/5X,I3,2I6,1P4E11.3)') | |
10361 | & 'PHO_SAMPRO: called with IP,IFP1/2,ECM,PVIR1/2,SPROB', | |
10362 | & IP,IFP1,IFP2,ECM,PVIR1,PVIR2,SPROB | |
10363 | ||
10364 | IF(IPROC.GE.0) THEN | |
10365 | ||
10366 | C interpolate cross sections | |
10367 | CALL PHO_CSINT(IP,IFP1,IFP2,-1,-1,ECM,PVIR1,PVIR2) | |
10368 | ||
10369 | C cross check | |
10370 | IF((IP.EQ.1).and.((SPROB.gt.1.D0).or.(SPROB.lt.0.D0))) THEN | |
10371 | WRITE(LO,'(/,1X,A,/5X,I12,I3,2I6,1P4E11.3)') | |
10372 | & 'PHO_SAMPRO: inconsistent gap survival probability', | |
10373 | & 'EVENT,IP,IFP1/2,ECM,PVIR1/2,SPROB:', | |
10374 | & KEVENT,IP,IFP1,IFP2,ECM,PVIR1,PVIR2,SPROB | |
10375 | ENDIF | |
10376 | ||
10377 | C calculate cumulative probabilities | |
10378 | IF(ISWMDL(1).EQ.3) THEN | |
10379 | IF(ISWMDL(2).GE.1) THEN | |
10380 | SIGSDI(1) = SIGLSD(1)+SIGHSD(1) | |
10381 | SIGSDI(2) = SIGLSD(2)+SIGHSD(2) | |
10382 | SIGDDI = SIGLDD+SIGHDD | |
10383 | SIGNDR = SIGINE-SIGVM(0,0)-SIGCDF(0)-SIGDIR | |
10384 | & - SIGSDI(1)-SIGSDI(2)-SIGDDI | |
10385 | XPROB(1) = SIGNDR*SPROB*DBLE(IPRON(1,IP)) | |
10386 | XPROB(2) = XPROB(1)+SIGELA*SPROB*DBLE(IPRON(2,IP)) | |
10387 | XPROB(3) = XPROB(2)+SIGVM(0,0)*SPROB*DBLE(IPRON(3,IP)) | |
10388 | XPROB(4) = XPROB(3)+SIGCDF(0)*SPROB*DBLE(IPRON(4,IP)) | |
10389 | XPROB(5) = XPROB(4)+SIGSDI(1)*SPROB*DBLE(IPRON(5,IP)) | |
10390 | XPROB(6) = XPROB(5)+SIGSDI(2)*SPROB*DBLE(IPRON(6,IP)) | |
10391 | XPROB(7) = XPROB(6)+SIGDDI*SPROB*DBLE(IPRON(7,IP)) | |
10392 | XPROB(8) = XPROB(7)+SIGDIR*DBLE(IPRON(8,IP)) | |
10393 | ELSE | |
10394 | SIGHR = 0.D0 | |
10395 | IF(IPRON(1,IP).EQ.1) SIGHR = SIGHAR | |
10396 | SIGHD = 0.D0 | |
10397 | IF(IPRON(8,IP).EQ.1) SIGHD = SIGDIR | |
10398 | XPROB(1) = SIGHR/(SIGHR+SIGHD) | |
10399 | XPROB(2) = XPROB(1) | |
10400 | XPROB(3) = XPROB(1) | |
10401 | XPROB(4) = XPROB(1) | |
10402 | XPROB(5) = XPROB(1) | |
10403 | XPROB(6) = XPROB(1) | |
10404 | XPROB(7) = XPROB(1) | |
10405 | XPROB(8) = XPROB(1)+SIGHD/(SIGHR+SIGHD) | |
10406 | ENDIF | |
10407 | ||
10408 | IF(IDEB(11).GE.15) THEN | |
10409 | WRITE(LO,'(1X,A,I3)') | |
10410 | & 'PHO_SAMPRO: partial cross sections for IP',IP | |
10411 | WRITE(LO,'(5X,I3,2X,1PE12.4)') 1,XPROB(1) | |
10412 | DO 240 I=2,8 | |
10413 | WRITE(LO,'(5X,I3,2X,1PE12.4)') I,XPROB(I)-XPROB(I-1) | |
10414 | 240 CONTINUE | |
10415 | ENDIF | |
10416 | ||
10417 | ELSE | |
10418 | WRITE(LO,'(/,1X,A,I4)') 'PHO_SAMPRO:ERROR: unsupported model', | |
10419 | & ISWMDL(1) | |
10420 | CALL PHO_ABORT | |
10421 | ENDIF | |
10422 | ||
10423 | IF(XPROB(8).LT.1.D-20) THEN | |
10424 | IF(IDEB(11).GE.2) | |
10425 | & WRITE(LO,'(1X,2A,/10X,A,1P3E11.3)') 'PHO_SAMPRO:ERROR: ', | |
10426 | & 'activated processes have vanishing cross section sum', | |
10427 | & 'IP,ECM,SIG_sum:',IP,ECM,XPROB(8) | |
10428 | IPROC = 0 | |
10429 | RETURN | |
10430 | ENDIF | |
10431 | ||
10432 | C sample process | |
10433 | XI = DT_RNDM(XI)*XPROB(8) | |
10434 | DO 100 I=1,8 | |
10435 | IF(XI.LE.XPROB(I)) GOTO 110 | |
10436 | 100 CONTINUE | |
10437 | 110 CONTINUE | |
10438 | IPROC = MIN(I,8) | |
10439 | ||
10440 | CALLS(IP) = CALLS(IP)+1.D0 | |
10441 | PRO(IPROC,IP) = PRO(IPROC,IP)+1.D0 | |
10442 | ECMSUM(IP) = ECMSUM(IP)+ECM | |
10443 | IF(ISWMDL(2).GE.1) THEN | |
10444 | SIGSUM(IP) = SIGSUM(IP)+XPROB(8) | |
10445 | ELSE | |
10446 | SIGSUM(IP) = SIGSUM(IP)+SIGGEN(3) | |
10447 | ENDIF | |
10448 | ||
10449 | C debug output | |
10450 | IF(IDEB(11).GE.5) WRITE(LO,'(1X,A,I3,I12,I4)') | |
10451 | & 'PHO_SAMPRO: IP,CALL,PROC-ID', | |
10452 | & IP,INT(CALLS(IP)+0.1D0),IPROC | |
10453 | ||
10454 | C statistics initialization | |
10455 | ELSE IF(IPROC.EQ.-1) THEN | |
10456 | DO 260 K=1,4 | |
10457 | DO 250 I=1,8 | |
10458 | PRO(I,K) = 0.D0 | |
10459 | 250 CONTINUE | |
10460 | CALLS(K) = 0.D0 | |
10461 | SIGSUM(K) = 0.D0 | |
10462 | ECMSUM(K) = 0.D0 | |
10463 | 260 CONTINUE | |
10464 | ||
10465 | C write out statistics | |
10466 | ELSE IF(IPROC.EQ.-2) THEN | |
10467 | KMAX = 4 | |
10468 | IF(ISWMDL(2).EQ.0) KMAX=1 | |
10469 | DO 270 K=1,KMAX | |
10470 | IF(CALLS(K).GT.0.5D0) THEN | |
10471 | SIGSUM(K) = SIGSUM(K)/CALLS(K)**2 | |
10472 | ECMSUM(K) = ECMSUM(K)/CALLS(K) | |
10473 | IF(IDEB(11).GE.0) THEN | |
10474 | WRITE(LO,'(/,1X,2A,I4,1PE12.3,/,1X,A)') | |
10475 | & 'PHO_SAMPRO: internal process statistics ', | |
10476 | & '(IP,<Ecm>)',K,ECMSUM(K), | |
10477 | & '---------------------------------------' | |
10478 | WRITE(LO,'(8X,A)') | |
10479 | & ' process sampled cross section' | |
10480 | IF(ISWMDL(2).GE.1) THEN | |
10481 | WRITE(LO,'(9(/5X,A,0PF12.0,5X,1PE12.3))') | |
10482 | & ' all processes',CALLS(K),CALLS(K)*SIGSUM(K), | |
10483 | & ' nondif.inelastic',PRO(1,K),PRO(1,K)*SIGSUM(K), | |
10484 | & ' elastic',PRO(2,K),PRO(2,K)*SIGSUM(K), | |
10485 | & 'vmeson production',PRO(3,K),PRO(3,K)*SIGSUM(K), | |
10486 | & ' double pomeron',PRO(4,K),PRO(4,K)*SIGSUM(K), | |
10487 | & ' single diffr.(1)',PRO(5,K),PRO(5,K)*SIGSUM(K), | |
10488 | & ' single diffr.(2)',PRO(6,K),PRO(6,K)*SIGSUM(K), | |
10489 | & ' double diffract.',PRO(7,K),PRO(7,K)*SIGSUM(K), | |
10490 | & ' direct processes',PRO(8,K),PRO(8,K)*SIGSUM(K) | |
10491 | ELSE | |
10492 | WRITE(LO,'(3(/5X,A,0PF12.0,5X,1PE12.3))') | |
10493 | & ' all processes',CALLS(K),CALLS(K)*SIGSUM(K), | |
10494 | & ' double resolved',PRO(1,K),PRO(1,K)*SIGSUM(K), | |
10495 | & ' single res + dir',PRO(8,K),PRO(8,K)*SIGSUM(K) | |
10496 | ENDIF | |
10497 | ENDIF | |
10498 | ENDIF | |
10499 | 270 CONTINUE | |
10500 | ENDIF | |
10501 | ||
10502 | END | |
10503 | ||
10504 | *$ CREATE PHO_SAMPRB.FOR | |
10505 | *COPY PHO_SAMPRB | |
10506 | CDECK ID>, PHO_SAMPRB | |
10507 | SUBROUTINE PHO_SAMPRB(ECMI,IP,ISAM,JSAM,KSAM) | |
10508 | C******************************************************************** | |
10509 | C | |
10510 | C routine to sample number of cut graphs of different kind | |
10511 | C | |
10512 | C input: IP scattering particle combination | |
10513 | C ECMI CMS energy | |
10514 | C IP -1 initialization | |
10515 | C -2 output of statistics | |
10516 | C others sampling of cuts | |
10517 | C | |
10518 | C output: ISAM number of soft Pomerons cut | |
10519 | C JSAM number of soft Reggeons cut | |
10520 | C KSAM number of hard Pomerons cut | |
10521 | C | |
10522 | C PHO_PRBDIS has to be called before | |
10523 | C | |
10524 | C******************************************************************** | |
10525 | IMPLICIT DOUBLE PRECISION (A-H,O-Z) | |
10526 | SAVE | |
10527 | ||
10528 | C input/output channels | |
10529 | INTEGER LI,LO | |
10530 | COMMON /POINOU/ LI,LO | |
10531 | C event debugging information | |
10532 | INTEGER NMAXD | |
10533 | PARAMETER (NMAXD=100) | |
10534 | INTEGER IDEB,KSPOM,KHPOM,KSREG,KHDIR,KACCEP,KSTRG,KHTRG,KSLOO, | |
10535 | & KHLOO,KSDPO,KHDPO,KEVENT,KSOFT,KHARD | |
10536 | COMMON /PODEBG/ IDEB(NMAXD),KSPOM,KHPOM,KSREG,KHDIR,KACCEP,KSTRG, | |
10537 | & KHTRG,KSLOO,KHLOO,KSDPO,KHDPO,KEVENT,KSOFT,KHARD | |
10538 | C model switches and parameters | |
10539 | CHARACTER*8 MDLNA | |
10540 | INTEGER ISWMDL,IPAMDL | |
10541 | DOUBLE PRECISION PARMDL | |
10542 | COMMON /POMDLS/ MDLNA(50),ISWMDL(50),PARMDL(400),IPAMDL(400) | |
10543 | C general process information | |
10544 | INTEGER IPROCE,IDNODF,IDIFR1,IDIFR2,IDDPOM,IPRON | |
10545 | COMMON /POPRCS/ IPROCE,IDNODF,IDIFR1,IDIFR2,IDDPOM,IPRON(15,4) | |
10546 | C nucleon-nucleus / nucleus-nucleus interface to DPMJET | |
10547 | INTEGER IDEQP,IDEQB,IHFLD,IHFLS | |
10548 | DOUBLE PRECISION ECMN,PCMN,SECM,SPCM,XPSUB,XTSUB | |
10549 | COMMON /POHDFL/ ECMN,PCMN,SECM,SPCM,XPSUB,XTSUB, | |
10550 | & IDEQP(2),IDEQB(2),IHFLD(2,2),IHFLS(2) | |
10551 | C obsolete cut-off information | |
10552 | DOUBLE PRECISION PTCUT,PTANO,FPS,FPH,PSOMIN,XSOMIN | |
10553 | COMMON /POCUT1/ PTCUT(4),PTANO(4),FPS(4),FPH(4),PSOMIN,XSOMIN | |
10554 | C cut probability distribution | |
10555 | INTEGER IEETA1,IIMAX,KKMAX | |
10556 | PARAMETER( IEETA1=20, IIMAX=20, KKMAX=20 ) | |
10557 | INTEGER IEEMAX,IMAX,KMAX | |
10558 | REAL PROB | |
10559 | DOUBLE PRECISION EPTAB | |
10560 | COMMON /POPROB/ PROB(4,IEETA1,0:IIMAX,0:KKMAX),EPTAB(4,IEETA1), | |
10561 | & IEEMAX,IMAX,KMAX | |
10562 | C global event kinematics and particle IDs | |
10563 | INTEGER IFPAP,IFPAB | |
10564 | DOUBLE PRECISION ECM,PCM,PMASS,PVIRT | |
10565 | COMMON /POGCMS/ ECM,PCM,PMASS(2),PVIRT(2),IFPAP(2),IFPAB(2) | |
10566 | C cross sections | |
10567 | INTEGER IPFIL,IFAFIL,IFBFIL | |
10568 | DOUBLE PRECISION SIGTOT,SIGELA,SIGVM,SIGINE,SIGNDF,SIGDIR, | |
10569 | & SIGLSD,SIGHSD,SIGLDD,SIGHDD,SIGCDF, | |
10570 | & SIGPOM,SIGREG,SIGHAR,SIGTR1,SIGTR2,SIGLOO, | |
10571 | & SIGDPO,SIG1SO,SIG1HA,SLOEL,SLOVM,SIGCOR, | |
10572 | & FSUP,FSUD,FSUH,ECMFIL,P2AFIL,P2BFIL | |
10573 | COMMON /POCSEC/ SIGTOT,SIGELA,SIGVM(0:4,0:4),SIGINE,SIGNDF,SIGDIR, | |
10574 | & SIGLSD(2),SIGHSD(2),SIGLDD,SIGHDD,SIGCDF(0:4), | |
10575 | & SIGPOM,SIGREG,SIGHAR,SIGTR1(2),SIGTR2(2),SIGLOO, | |
10576 | & SIGDPO(4),SIG1SO,SIG1HA,SLOEL,SLOVM(4,4),SIGCOR, | |
10577 | & FSUP(2),FSUD(2),FSUH(2),ECMFIL,P2AFIL,P2BFIL, | |
10578 | & IPFIL,IFAFIL,IFBFIL | |
10579 | C table of particle indices for recursive PHOJET calls | |
10580 | INTEGER MAXIPX | |
10581 | PARAMETER ( MAXIPX = 100 ) | |
10582 | INTEGER IPOPOS,IPORES,IPOIX1,IPOIX2,IPOIX3 | |
10583 | COMMON /PORECU/ IPOPOS(2,MAXIPX),IPORES(MAXIPX), | |
10584 | & IPOIX1,IPOIX2,IPOIX3 | |
10585 | ||
10586 | DIMENSION ECMS1(4),ECMS2(4),AVERB(0:3,4),AVERC(0:3,4) | |
10587 | ||
10588 | C sample number of interactions | |
10589 | IF(IP.GE.0) THEN | |
10590 | ITER = 0 | |
10591 | ECMX = ECMI | |
10592 | ECMC = ECMI | |
10593 | KLIM = 1 | |
10594 | IF((IPAMDL(13).GT.0).AND.(IPROCE.EQ.1).AND.(IPOIX3.EQ.0)) THEN | |
10595 | IF(IPAMDL(16).EQ.0) ECMC = SECM | |
10596 | KLIM = 0 | |
10597 | ENDIF | |
10598 | ||
10599 | C sample up to kinematic limits only | |
10600 | IMAX1 = MIN(IMAX,INT(0.4D0*ECMC/PARMDL(161))) | |
10601 | IF(IMAX1.LT.1) THEN | |
10602 | IF(IPAMDL(2).EQ.1) THEN | |
10603 | C reggeon allowed | |
10604 | ISAM = 0 | |
10605 | JSAM = 1 | |
10606 | KSAM = 0 | |
10607 | AVERB(3,IP) = AVERB(3,IP)+1.D0 | |
10608 | ELSE | |
10609 | C only pomeron even at very low energies | |
10610 | ISAM = 1 | |
10611 | JSAM = 0 | |
10612 | KSAM = 0 | |
10613 | AVERB(1,IP) = AVERB(1,IP)+1.D0 | |
10614 | ENDIF | |
10615 | AVERB(0,IP) = AVERB(0,IP)+1.D0 | |
10616 | GOTO 150 | |
10617 | ENDIF | |
10618 | C find interpolation factors | |
10619 | IF(ECMX.LE.EPTAB(IP,1)) THEN | |
10620 | I1 = 1 | |
10621 | I2 = 1 | |
10622 | ELSE IF(ECMX.LT.EPTAB(IP,IEEMAX)) THEN | |
10623 | DO 50 I=2,IEEMAX | |
10624 | IF(ECMX.LE.EPTAB(IP,I)) GOTO 200 | |
10625 | 50 CONTINUE | |
10626 | 200 CONTINUE | |
10627 | I1 = I-1 | |
10628 | I2 = I | |
10629 | ELSE | |
10630 | WRITE(LO,'(/1X,A,2E12.3)') | |
10631 | & 'PHO_SAMPRB:too high energy',ECMX,EPTAB(IP,IEEMAX) | |
10632 | CALL PHO_PREVNT(-1) | |
10633 | I1 = IEEMAX | |
10634 | I2 = IEEMAX | |
10635 | ENDIF | |
10636 | FAC2 = 0.D0 | |
10637 | IF(I1.NE.I2) | |
10638 | & FAC2=LOG(ECMX/EPTAB(IP,I1))/LOG(EPTAB(IP,I2)/EPTAB(IP,I1)) | |
10639 | FAC1=1.D0-FAC2 | |
10640 | C reggeon probability | |
10641 | PREG = -(PROB(IP,I1,0,0)*FAC1+PROB(IP,I2,0,0)*FAC2) | |
10642 | C calculate soft suppression factor | |
10643 | IF(IP.EQ.1) FSUPP = PARMDL(35)**2 | |
10644 | & /((PVIRT(1)+PARMDL(35))*(PVIRT(2)+PARMDL(35))) | |
10645 | C | |
10646 | 10 CONTINUE | |
10647 | ITER = ITER+1 | |
10648 | XI = DT_RNDM(FAC2) | |
10649 | DO 260 KSAM=0,KMAX | |
10650 | DO 270 ISAM=0,IMAX | |
10651 | PRO = PROB(IP,I1,ISAM,KSAM)*FAC1 | |
10652 | & +PROB(IP,I2,ISAM,KSAM)*FAC2 | |
10653 | IF(PRO.GT.XI) GOTO 100 | |
10654 | 270 CONTINUE | |
10655 | 260 CONTINUE | |
10656 | ISAM = MIN(IMAX,ISAM) | |
10657 | KSAM = MIN(KMAX,KSAM) | |
10658 | ||
10659 | 100 CONTINUE | |
10660 | ||
10661 | IF(ITER.GT.100) THEN | |
10662 | ||
10663 | ISAM = 0 | |
10664 | JSAM = 1 | |
10665 | KSAM = 0 | |
10666 | IF(IDEB(12).GE.3) WRITE(LO,'(1X,A,I10,E11.3,I6)') | |
10667 | & 'PHO_SAMPRB: rejection (EV,ECM,ITER)',KEVENT,ECMX,ITER | |
10668 | ||
10669 | ELSE | |
10670 | ||
10671 | C reggeon contribution | |
10672 | JSAM = 0 | |
10673 | IF(IPAMDL(2).EQ.1) THEN | |
10674 | DO 90 I=1,ISAM | |
10675 | IF(DT_RNDM(PRO).LT.PREG) JSAM = JSAM+1 | |
10676 | 90 CONTINUE | |
10677 | ISAM = ISAM-JSAM | |
10678 | ENDIF | |
10679 | C statistics of bare cuts | |
10680 | IF(ITER.EQ.1) THEN | |
10681 | AVERB(0,IP) = AVERB(0,IP)+1.D0 | |
10682 | AVERB(1,IP) = AVERB(1,IP)+DBLE(ISAM) | |
10683 | AVERB(2,IP) = AVERB(2,IP)+DBLE(KSAM) | |
10684 | AVERB(3,IP) = AVERB(3,IP)+DBLE(JSAM) | |
10685 | ENDIF | |
10686 | C limitation given by field dimensions | |
10687 | IF((2*ISAM+JSAM+3*KSAM).GT.50) GOTO 10 | |
10688 | ||
10689 | IF(IP.EQ.1) THEN | |
10690 | ||
10691 | C reweight according to virtualities and PDF treatment | |
10692 | IF(IPAMDL(115).GE.1) THEN | |
10693 | IF(KSAM.EQ.0) THEN | |
10694 | IF(FSUP(1)*FSUP(2).LT.DT_RNDM(ECMI)) GOTO 10 | |
10695 | ENDIF | |
10696 | ENDIF | |
10697 | ||
10698 | C reduce number of cuts according to photon virtualities | |
10699 | IF(IPAMDL(114).GE.1) THEN | |
10700 | 110 CONTINUE | |
10701 | I = ISAM+JSAM | |
10702 | WGX = FSUPP**I | |
10703 | IF(DT_RNDM(WGX).GT.WGX) THEN | |
10704 | IF(ISAM+JSAM+KSAM.GT.1) THEN | |
10705 | IF(JSAM.GT.0) THEN | |
10706 | JSAM = JSAM-1 | |
10707 | GOTO 110 | |
10708 | ELSE IF(ISAM.GT.0) THEN | |
10709 | ISAM = ISAM-1 | |
10710 | GOTO 110 | |
10711 | ENDIF | |
10712 | ENDIF | |
10713 | ENDIF | |
10714 | ENDIF | |
10715 | ||
10716 | ENDIF | |
10717 | ||
10718 | C phase space limitation | |
10719 | 120 CONTINUE | |
10720 | XM = DBLE(2*ISAM+JSAM)*PARMDL(160+IP) | |
10721 | & +DBLE(2*KSAM)*PTCUT(IP) | |
10722 | PACC = EXP(PARMDL(9)*(PARMDL(160+IP)-XM)/ECMC) | |
10723 | IF(DT_RNDM(XM).GT.PACC) THEN | |
10724 | IF(ISAM+JSAM+KSAM.GT.1) THEN | |
10725 | IF(JSAM.GT.0) THEN | |
10726 | JSAM = JSAM-1 | |
10727 | GOTO 120 | |
10728 | ELSE IF(ISAM.GT.0) THEN | |
10729 | ISAM = ISAM-1 | |
10730 | GOTO 120 | |
10731 | ELSE IF(KSAM.GT.KLIM) THEN | |
10732 | KSAM = KSAM-1 | |
10733 | GOTO 120 | |
10734 | ENDIF | |
10735 | ENDIF | |
10736 | ENDIF | |
10737 | ||
10738 | ENDIF | |
10739 | ||
10740 | ISAM = ISAM+JSAM/2 | |
10741 | JSAM = MOD(JSAM,2) | |
10742 | C collect statistics | |
10743 | 150 CONTINUE | |
10744 | ECMS1(IP) = ECMS1(IP)+ECMX | |
10745 | ECMS2(IP) = ECMS2(IP)+ECMC | |
10746 | AVERC(0,IP) = AVERC(0,IP)+1.D0 | |
10747 | AVERC(1,IP) = AVERC(1,IP)+DBLE(ISAM) | |
10748 | AVERC(2,IP) = AVERC(2,IP)+DBLE(KSAM) | |
10749 | AVERC(3,IP) = AVERC(3,IP)+DBLE(JSAM) | |
10750 | C | |
10751 | IF(IDEB(12).GE.10) WRITE(LO,'(1X,A,2E11.4,3I4)') | |
10752 | & 'PHO_SAMPRB: ECM,I,J,K',ECM,ECMX,ISAM,JSAM,KSAM | |
10753 | C | |
10754 | C initialize statistics | |
10755 | ELSE IF(IP.EQ.-1) THEN | |
10756 | DO 60 I=1,4 | |
10757 | ECMS1(I) = 0.D0 | |
10758 | ECMS2(I) = 0.D0 | |
10759 | DO 65 K=0,3 | |
10760 | AVERB(K,I) = 0.D0 | |
10761 | AVERC(K,I) = 0.D0 | |
10762 | 65 CONTINUE | |
10763 | 60 CONTINUE | |
10764 | RETURN | |
10765 | C | |
10766 | C write out statistics | |
10767 | ELSE IF(IP.EQ.-2) THEN | |
10768 | WRITE(LO,'(2(/1X,A))') 'PHO_SAMPRB: interaction statistics', | |
10769 | & '----------------------------------' | |
10770 | DO 70 I=1,4 | |
10771 | IF(AVERB(0,I).LT.2.D0) GOTO 75 | |
10772 | WRITE(LO,'(1X,A,I3,1P,2E13.3)') | |
10773 | & 'statistics for IP,<Ecm_1>,<Ecm_2>',I, | |
10774 | & ECMS1(I)/MAX(AVERB(0,I),1.D0),ECMS2(I)/MAX(AVERB(0,I),1.D0) | |
10775 | WRITE(LO,'(5X,A)') | |
10776 | & 'average number of s-pom,h-pom,reg cuts (bare)' | |
10777 | WRITE(LO,'(5X,F12.0,1P3E12.4)') AVERB(0,I), | |
10778 | & (AVERB(K,I)/AVERB(0,I),K=1,3) | |
10779 | WRITE(LO,'(5X,A)') | |
10780 | & 'average (with energy/virtuality corrections)' | |
10781 | WRITE(LO,'(5X,F12.0,1P3E12.4)') AVERC(0,I), | |
10782 | & (AVERC(K,I)/AVERC(0,I),K=1,3) | |
10783 | ||
10784 | 75 CONTINUE | |
10785 | 70 CONTINUE | |
10786 | RETURN | |
10787 | ENDIF | |
10788 | END | |
10789 | ||
10790 | *$ CREATE PHO_TRIREG.FOR | |
10791 | *COPY PHO_TRIREG | |
10792 | CDECK ID>, PHO_TRIREG | |
10793 | SUBROUTINE PHO_TRIREG(S,GA,AA,GB,BB,DELTA,ALPHAP,GPPP,BPPP,VIR2A, | |
10794 | & SIGTR,BTR) | |
10795 | C********************************************************************** | |
10796 | C | |
10797 | C calculation of triple-Pomeron total cross section | |
10798 | C according to Gribov's Regge theory | |
10799 | C | |
10800 | C input: S squared cms energy | |
10801 | C GA coupling constant to diffractive line | |
10802 | C AA slope related to GA (GeV**-2) | |
10803 | C GB coupling constant to elastic line | |
10804 | C BB slope related to GB (GeV**-2) | |
10805 | C DELTA effective pomeron delta (intercept-1) | |
10806 | C ALPHAP slope of pomeron trajectory (GeV**-2) | |
10807 | C GPPP triple-Pomeron coupling | |
10808 | C BPPP slope related to B0PPP (GeV**-2) | |
10809 | C VIR2A virtuality of particle a (GeV**2) | |
10810 | C note: units of all coupling constants are mb**1/2 | |
10811 | C | |
10812 | C output: SIGTR total triple-Pomeron cross section | |
10813 | C BTR effective triple-Pomeron slope | |
10814 | C (differs from diffractive slope!) | |
10815 | C | |
10816 | C uses E_i (Exponential-Integral function) | |
10817 | C | |
10818 | C********************************************************************** | |
10819 | IMPLICIT DOUBLE PRECISION (A-H,O-Z) | |
10820 | SAVE | |
10821 | ||
10822 | PARAMETER (EPS =0.0001D0) | |
10823 | ||
10824 | C input/output channels | |
10825 | INTEGER LI,LO | |
10826 | COMMON /POINOU/ LI,LO | |
10827 | C event debugging information | |
10828 | INTEGER NMAXD | |
10829 | PARAMETER (NMAXD=100) | |
10830 | INTEGER IDEB,KSPOM,KHPOM,KSREG,KHDIR,KACCEP,KSTRG,KHTRG,KSLOO, | |
10831 | & KHLOO,KSDPO,KHDPO,KEVENT,KSOFT,KHARD | |
10832 | COMMON /PODEBG/ IDEB(NMAXD),KSPOM,KHPOM,KSREG,KHDIR,KACCEP,KSTRG, | |
10833 | & KHTRG,KSLOO,KHLOO,KSDPO,KHDPO,KEVENT,KSOFT,KHARD | |
10834 | C some constants | |
10835 | DOUBLE PRECISION PI,PI2,PI4,GEV2MB,Q_ch,Q_ch2,Q_ch4 | |
10836 | COMMON /POCONS/ PI,PI2,PI4,GEV2MB, | |
10837 | & Q_ch(-6:6),Q_ch2(-6:6),Q_ch4(-6:6) | |
10838 | ||
10839 | C integration cut-off Sigma_U ( see Nucl.Phys.B97(1975)493 ) | |
10840 | SIGU = 2.5 | |
10841 | C integration cut-off Sigma_L (min. squared mass of diff. blob) | |
10842 | SIGL = 5.+VIR2A | |
10843 | C debug output | |
10844 | IF(IDEB(50).GE.10) WRITE(LO,'(1X,A,/1X,1P,9E10.3)') | |
10845 | & 'PHO_TRIREG: S,GA,AA,GB,BB,DELTA,ALPHAP,GPPP,BPPP ', | |
10846 | & S,GA,AA,GB,BB,DELTA,ALPHAP,GPPP,BPPP | |
10847 | C | |
10848 | IF(S.LT.5.D0) THEN | |
10849 | SIGTR = 0.D0 | |
10850 | BTR = BPPP+BB | |
10851 | RETURN | |
10852 | ENDIF | |
10853 | C change units of ALPHAP to mb | |
10854 | ALSCA = ALPHAP*GEV2MB | |
10855 | C | |
10856 | C cross section | |
10857 | PART1=GA*GB**2*GPPP/(16.*PI*2.*ALSCA)*S**DELTA* | |
10858 | & EXP(-(BB+BPPP)/(2.*ALPHAP)*DELTA) | |
10859 | PART2=PHO_EXPINT(((BB+BPPP)/(2.*ALPHAP)+LOG(S/SIGL))*DELTA) | |
10860 | PART3=PHO_EXPINT(((BB+BPPP)/(2.*ALPHAP)+LOG(SIGU))*DELTA) | |
10861 | C | |
10862 | SIGTR=PART1*(PART2-PART3) | |
10863 | C | |
10864 | C slope | |
10865 | PART1 = (BB+BPPP+2.*ALPHAP*LOG(S/SIGL))/ | |
10866 | & (BB+BPPP+2.*ALPHAP*LOG(SIGU)) | |
10867 | PART2 = LOG(PART1) | |
10868 | PART1 = 0.5D0*ALPHAP*LOG(1.D0+S/(SIGU*SIGL))/PART2 | |
10869 | BTR = (AA+BB/2.D0)/2.D0+BPPP+ALPHAP*LOG(S/4.D0) | |
10870 | BTR = BTR-PART1 | |
10871 | C | |
10872 | IF(SIGTR.LT.EPS) SIGTR = 0.D0 | |
10873 | IF(BTR.LT.BB) BTR = BB | |
10874 | C | |
10875 | IF(IDEB(50).GE.7) WRITE(LO,'(1X,A,1P,3E12.3)') | |
10876 | & 'PHO_TRIREG: ENERGY,SIGTR,BTR ',SQRT(S),SIGTR,BTR | |
10877 | END | |
10878 | ||
10879 | *$ CREATE PHO_LOOREG.FOR | |
10880 | *COPY PHO_LOOREG | |
10881 | CDECK ID>, PHO_LOOREG | |
10882 | SUBROUTINE PHO_LOOREG(S,GA,AA,GB,BB,DELTA,ALPHAP,GPPP,BPPP, | |
10883 | & VIR2A,VIR2B,SIGLO,BLO) | |
10884 | C********************************************************************** | |
10885 | C | |
10886 | C calculation of loop-Pomeron total cross section | |
10887 | C according to Gribov's Regge theory | |
10888 | C | |
10889 | C input: S squared cms energy | |
10890 | C GA coupling constant to diffractive line | |
10891 | C AA slope related to GA (GeV**-2) | |
10892 | C GB coupling constant to elastic line | |
10893 | C BB slope related to GB (GeV**-2) | |
10894 | C DELTA effective pomeron delta (intercept-1) | |
10895 | C ALPHAP slope of pomeron trajectory (GeV**-2) | |
10896 | C GPPP triple-Pomeron coupling | |
10897 | C BPPP slope related to B0PPP (GeV**-2) | |
10898 | C VIR2A virtuality of particle a (GeV**2) | |
10899 | C VIR2B virtuality of particle b (GeV**2) | |
10900 | C note: units of all coupling constants are mb**1/2 | |
10901 | C | |
10902 | C output: SIGLO total loop-Pomeron cross section | |
10903 | C BLO effective loop-Pomeron slope | |
10904 | C (differs from double diffractive slope!) | |
10905 | C | |
10906 | C uses E_i (Exponential-Integral function) | |
10907 | C | |
10908 | C********************************************************************** | |
10909 | IMPLICIT DOUBLE PRECISION (A-H,O-Z) | |
10910 | SAVE | |
10911 | ||
10912 | PARAMETER (EPS =0.0001D0) | |
10913 | ||
10914 | C input/output channels | |
10915 | INTEGER LI,LO | |
10916 | COMMON /POINOU/ LI,LO | |
10917 | C event debugging information | |
10918 | INTEGER NMAXD | |
10919 | PARAMETER (NMAXD=100) | |
10920 | INTEGER IDEB,KSPOM,KHPOM,KSREG,KHDIR,KACCEP,KSTRG,KHTRG,KSLOO, | |
10921 | & KHLOO,KSDPO,KHDPO,KEVENT,KSOFT,KHARD | |
10922 | COMMON /PODEBG/ IDEB(NMAXD),KSPOM,KHPOM,KSREG,KHDIR,KACCEP,KSTRG, | |
10923 | & KHTRG,KSLOO,KHLOO,KSDPO,KHDPO,KEVENT,KSOFT,KHARD | |
10924 | C some constants | |
10925 | DOUBLE PRECISION PI,PI2,PI4,GEV2MB,Q_ch,Q_ch2,Q_ch4 | |
10926 | COMMON /POCONS/ PI,PI2,PI4,GEV2MB, | |
10927 | & Q_ch(-6:6),Q_ch2(-6:6),Q_ch4(-6:6) | |
10928 | ||
10929 | C integration cut-off Sigma_U ( see Nucl.Phys.B97(1975)493 ) | |
10930 | SIGU = 2.5 | |
10931 | C integration cut-off Sigma_L (min. squared mass of diff. blob) | |
10932 | SIGL = 5.+VIR2A+VIR2B | |
10933 | C debug output | |
10934 | IF(IDEB(51).GE.10) WRITE(LO,'(1X,A,/1X,1P,9E10.3)') | |
10935 | & 'PHO_LOOREG: S,GA,AA,GB,BB,DELTA,ALPHAP,GPPP,BPPP ', | |
10936 | & S,GA,AA,GB,BB,DELTA,ALPHAP,GPPP,BPPP | |
10937 | C | |
10938 | IF(S.LT.5.D0) THEN | |
10939 | SIGLO = 0.D0 | |
10940 | BLO = 2.D0*BPPP | |
10941 | RETURN | |
10942 | ENDIF | |
10943 | ||
10944 | C | |
10945 | C change units of ALPHAP to mb | |
10946 | ALSCA = ALPHAP*GEV2MB | |
10947 | C | |
10948 | C cross section | |
10949 | PART1=GA*GB*GPPP**2/(16.*PI*2.*ALSCA)*S**DELTA* | |
10950 | & EXP(-DELTA*BPPP/ALPHAP) | |
10951 | PARTA=BPPP/ALPHAP+LOG(S/SIGL**2) | |
10952 | PARTB=BPPP/ALPHAP+LOG(SIGU) | |
10953 | SIGLO=PART1*(PARTA*(PHO_EXPINT(PARTA*DELTA) | |
10954 | & -PHO_EXPINT(PARTB*DELTA)) | |
10955 | & +EXP(PARTA*DELTA)/DELTA-EXP(PARTB*DELTA)/DELTA | |
10956 | & ) | |
10957 | C | |
10958 | C slope | |
10959 | PART1 = LOG(ABS(PARTA/PARTB)) | |
10960 | & *(PARTA-LOG(1.D0+S/(SIGL**2*SIGU))) | |
10961 | PART1 = 0.25*ALPHAP*LOG(1.D0+S/(SIGU*SIGL))**2/PART1 | |
10962 | BLO = (AA+BB)/2.+2.*BPPP+ALPHAP*LOG(S/4.D0) | |
10963 | BLO = BLO-PART1 | |
10964 | C | |
10965 | IF(SIGLO.LT.EPS) SIGLO = 0.D0 | |
10966 | IF(BLO.LT.2.D0*BPPP) BLO = 2.D0*BPPP | |
10967 | C | |
10968 | IF(IDEB(51).GE.7) WRITE(LO,'(1X,A,1P,3E12.3)') | |
10969 | & 'PHO_LOOREG: ENERGY,SIGLO,BLO',SQRT(S),SIGLO,BLO | |
10970 | END | |
10971 | ||
10972 | *$ CREATE PHO_TRXPOM.FOR | |
10973 | *COPY PHO_TRXPOM | |
10974 | CDECK ID>, PHO_TRXPOM | |
10975 | SUBROUTINE PHO_TRXPOM(S,GA,AA,GB,BB,DELTA,ALPHAP, | |
10976 | & GPPP,BPPP,SIGDP,BDP) | |
10977 | C********************************************************************** | |
10978 | C | |
10979 | C calculation of total cross section of two tripe-Pomeron | |
10980 | C graphs in X configuration according to Gribov's Reggeon field | |
10981 | C theory | |
10982 | C | |
10983 | C input: S squared cms energy | |
10984 | C GA coupling constant to elastic line 1 | |
10985 | C AA slope related to GA (GeV**-2) | |
10986 | C GB coupling constant to elastic line 2 | |
10987 | C BB slope related to GB (GeV**-2) | |
10988 | C DELTA effective pomeron delta (intercept-1) | |
10989 | C ALPHAP slope of pomeron trajectory (GeV**-2) | |
10990 | C BPPP triple-Pomeron coupling | |
10991 | C BTR slope related to B0PPP (GeV**-2) | |
10992 | C note: units of all coupling constants are mb**1/2 | |
10993 | C | |
10994 | C output: SIGDP total cross section for double-Pomeron | |
10995 | C scattering | |
10996 | C BDP effective double-Pomeron slope | |
10997 | C | |
10998 | C********************************************************************** | |
10999 | IMPLICIT DOUBLE PRECISION (A-H,O-Z) | |
11000 | SAVE | |
11001 | ||
11002 | PARAMETER (EPS =0.0001D0) | |
11003 | ||
11004 | C input/output channels | |
11005 | INTEGER LI,LO | |
11006 | COMMON /POINOU/ LI,LO | |
11007 | C event debugging information | |
11008 | INTEGER NMAXD | |
11009 | PARAMETER (NMAXD=100) | |
11010 | INTEGER IDEB,KSPOM,KHPOM,KSREG,KHDIR,KACCEP,KSTRG,KHTRG,KSLOO, | |
11011 | & KHLOO,KSDPO,KHDPO,KEVENT,KSOFT,KHARD | |
11012 | COMMON /PODEBG/ IDEB(NMAXD),KSPOM,KHPOM,KSREG,KHDIR,KACCEP,KSTRG, | |
11013 | & KHTRG,KSLOO,KHLOO,KSDPO,KHDPO,KEVENT,KSOFT,KHARD | |
11014 | C model switches and parameters | |
11015 | CHARACTER*8 MDLNA | |
11016 | INTEGER ISWMDL,IPAMDL | |
11017 | DOUBLE PRECISION PARMDL | |
11018 | COMMON /POMDLS/ MDLNA(50),ISWMDL(50),PARMDL(400),IPAMDL(400) | |
11019 | C some constants | |
11020 | DOUBLE PRECISION PI,PI2,PI4,GEV2MB,Q_ch,Q_ch2,Q_ch4 | |
11021 | COMMON /POCONS/ PI,PI2,PI4,GEV2MB, | |
11022 | & Q_ch(-6:6),Q_ch2(-6:6),Q_ch4(-6:6) | |
11023 | ||
11024 | DIMENSION XWGH1(96),XPOS1(96) | |
11025 | ||
11026 | C lower integration cut-off Sigma_L | |
11027 | SIGL = PARMDL(71)**2 | |
11028 | C upper integration cut-off Sigma_U | |
11029 | C = 1.D0-1.D0/PARMDL(70)**2 | |
11030 | C = MAX(PARMDL(72),C) | |
11031 | SIGU = (1.D0-C)**2*S | |
11032 | C integration precision | |
11033 | NGAUS1=16 | |
11034 | C | |
11035 | C debug output | |
11036 | IF(IDEB(52).GE.10) WRITE(LO,'(1X,A,/1X,1P,9E10.3)') | |
11037 | & 'PHO_TRXPOM: S,GA,AA,GB,BB,DELTA,ALPHAP,GPPP,BPPP', | |
11038 | & S,GA,AA,GB,BB,DELTA,ALPHAP,GPPP,BPPP | |
11039 | C | |
11040 | IF(SIGU.LE.SIGL) THEN | |
11041 | SIGDP = 0.D0 | |
11042 | BDP = AA+BB | |
11043 | RETURN | |
11044 | ENDIF | |
11045 | C | |
11046 | C cross section | |
11047 | C | |
11048 | XIL = LOG(SIGL) | |
11049 | XIU = LOG(SIGU) | |
11050 | XI = LOG(S) | |
11051 | FAC = (GPPP*GA*GB)**2/(256.D0*PI2)/ALPHAP/GEV2MB**2 | |
11052 | ALPHA2 = 2.D0*ALPHAP | |
11053 | ALOC = LOG(1.D0/(1.D0-C)) | |
11054 | CALL PHO_GAUSET(XIL,XIU,NGAUS1,XPOS1,XWGH1) | |
11055 | XSUM = 0.D0 | |
11056 | DO 100 I1=1,NGAUS1 | |
11057 | AMXSQ = EXP(XPOS1(I1)) | |
11058 | ALOSMX = LOG(S/AMXSQ) | |
11059 | ALCSMX = LOG((1.D0-C)*S/AMXSQ) | |
11060 | W = LOG((AA+BPPP+ALPHA2*ALCSMX)/(BB+BPPP+ALPHA2*ALOC)) | |
11061 | W = MAX(0.D0,W) | |
11062 | WN=(AA+BB+2.D0*BPPP+ALPHA2*ALOSMX) | |
11063 | C supercritical part | |
11064 | WSC = AMXSQ**DELTA*(S/AMXSQ)**(2.D0*DELTA) | |
11065 | XSUM = XSUM + W*XWGH1(I1)/WN*WSC | |
11066 | 100 CONTINUE | |
11067 | SIGDP = XSUM*FAC | |
11068 | C | |
11069 | C slope | |
11070 | BDP = 0.5*(AA+BB+BPPP+ALPHAP*XI) | |
11071 | C | |
11072 | IF(IDEB(52).GE.7) WRITE(LO,'(1X,A,1P,3E12.3)') | |
11073 | & 'PHO_TRXPOM: ENERGY,SIGDP,BDP',SQRT(S),SIGDP,BDP | |
11074 | END | |
11075 | ||
11076 | *$ CREATE PHO_CHAN2A.FOR | |
11077 | *COPY PHO_CHAN2A | |
11078 | CDECK ID>, PHO_CHAN2A | |
11079 | SUBROUTINE PHO_CHAN2A(BB) | |
11080 | C*********************************************************************** | |
11081 | C | |
11082 | C simple two channel model to realize low mass diffraction | |
11083 | C (version A, iteration of triple- and loop-Pomeron) | |
11084 | C | |
11085 | C input: BB impact parameter (mb**1/2) | |
11086 | C | |
11087 | C output: /POINT4/ | |
11088 | C AMPEL elastic amplitude | |
11089 | C AMPVM(4,4) q-elastic VM production | |
11090 | C AMLMSD(2) low mass single diffraction amplitude | |
11091 | C AMHMSD(2) high mass single diffraction amplitude | |
11092 | C AMLMDD low mass double diffraction amplitude | |
11093 | C AMHMDD high mass double diffraction amplitude | |
11094 | C AMPDP(4) central diffraction amplitude | |
11095 | C | |
11096 | C*********************************************************************** | |
11097 | IMPLICIT DOUBLE PRECISION (A-H,O-Z) | |
11098 | SAVE | |
11099 | ||
11100 | PARAMETER (DEPS = 1.D-5, | |
11101 | & EIGHT = 8.D0) | |
11102 | ||
11103 | C input/output channels | |
11104 | INTEGER LI,LO | |
11105 | COMMON /POINOU/ LI,LO | |
11106 | C event debugging information | |
11107 | INTEGER NMAXD | |
11108 | PARAMETER (NMAXD=100) | |
11109 | INTEGER IDEB,KSPOM,KHPOM,KSREG,KHDIR,KACCEP,KSTRG,KHTRG,KSLOO, | |
11110 | & KHLOO,KSDPO,KHDPO,KEVENT,KSOFT,KHARD | |
11111 | COMMON /PODEBG/ IDEB(NMAXD),KSPOM,KHPOM,KSREG,KHDIR,KACCEP,KSTRG, | |
11112 | & KHTRG,KSLOO,KHLOO,KSDPO,KHDPO,KEVENT,KSOFT,KHARD | |
11113 | C model switches and parameters | |
11114 | CHARACTER*8 MDLNA | |
11115 | INTEGER ISWMDL,IPAMDL | |
11116 | DOUBLE PRECISION PARMDL | |
11117 | COMMON /POMDLS/ MDLNA(50),ISWMDL(50),PARMDL(400),IPAMDL(400) | |
11118 | C some constants | |
11119 | DOUBLE PRECISION PI,PI2,PI4,GEV2MB,Q_ch,Q_ch2,Q_ch4 | |
11120 | COMMON /POCONS/ PI,PI2,PI4,GEV2MB, | |
11121 | & Q_ch(-6:6),Q_ch2(-6:6),Q_ch4(-6:6) | |
11122 | C complex Born graph amplitudes used for unitarization | |
11123 | COMPLEX*16 AMPEL,AMPVM,AMPSOF,AMPHAR,AMLMSD,AMHMSD,AMLMDD, | |
11124 | & AMHMDD,AMPDP | |
11125 | COMMON /POINT4/ AMPEL,AMPVM(4,4),AMPSOF,AMPHAR,AMLMSD(2), | |
11126 | & AMHMSD(2),AMLMDD,AMHMDD,AMPDP(4) | |
11127 | C unitarized amplitudes for different diffraction channels | |
11128 | DOUBLE PRECISION ZXP,BXP,ZXR,BXR,ZXH,BXH,ZXD,BXD, | |
11129 | & ZXT1A,BXT1A,ZXT1B,BXT1B,ZXT2A,BXT2A,ZXT2B,BXT2B, | |
11130 | & ZXDPE,BXDPE,ZXDPA,BXDPA,ZXDPB,BXDPB,ZXDPD,BXDPD, | |
11131 | & ZXL,BXL | |
11132 | COMMON /POINT5/ ZXP(4,4),BXP(4,4),ZXR(4,4),BXR(4,4), | |
11133 | & ZXH(4,4),BXH(4,4),ZXD(4,4),BXD(4,4), | |
11134 | & ZXT1A(4,4),BXT1A(4,4),ZXT1B(4,4),BXT1B(4,4), | |
11135 | & ZXT2A(4,4),BXT2A(4,4),ZXT2B(4,4),BXT2B(4,4), | |
11136 | & ZXDPE(4,4),BXDPE(4,4),ZXDPA(4,4),BXDPA(4,4), | |
11137 | & ZXDPB(4,4),BXDPB(4,4),ZXDPD(4,4),BXDPD(4,4), | |
11138 | & ZXL(4,4),BXL(4,4) | |
11139 | C Reggeon phenomenology parameters | |
11140 | DOUBLE PRECISION ALPOM,ALPOMP,GP,B0POM,ALREG,ALREGP,GR,B0REG, | |
11141 | & GPPP,GPPR,B0PPP,B0PPR,VDMFAC,VDMQ2F,B0HAR,AKFAC | |
11142 | COMMON /POPREG/ ALPOM,ALPOMP,GP(2),B0POM(2), | |
11143 | & ALREG,ALREGP,GR(2),B0REG(2), | |
11144 | & GPPP,GPPR,B0PPP,B0PPR, | |
11145 | & VDMFAC(4),VDMQ2F(4),B0HAR,AKFAC | |
11146 | C parameters of 2x2 channel model | |
11147 | DOUBLE PRECISION PHISUP,RMASS,VAR,AMPFAC,ELAFAC,VFAC | |
11148 | COMMON /PO2CHA/ PHISUP(2),RMASS(2),VAR,AMPFAC(4),ELAFAC(4),VFAC | |
11149 | C global event kinematics and particle IDs | |
11150 | INTEGER IFPAP,IFPAB | |
11151 | DOUBLE PRECISION ECM,PCM,PMASS,PVIRT | |
11152 | COMMON /POGCMS/ ECM,PCM,PMASS(2),PVIRT(2),IFPAP(2),IFPAB(2) | |
11153 | ||
11154 | C local variables | |
11155 | DIMENSION AB(9,4),CHI(4),CHDS(4),CHDH(4),CHDA(4),CHDB(4), | |
11156 | & CHDD(4),CHDPE(4),CHDPA(4),CHDPB(4),CHDPD(4), | |
11157 | & AMPCHA(4),EX1CHI(4),EX2CHI(4),ABSUM(4),AMPELA(4,0:9) | |
11158 | DIMENSION CHIFAC(4,4),EXPFAC(4,4),IELTAB(4,4) | |
11159 | ||
11160 | C combinatorical factors | |
11161 | DATA CHIFAC / 1.D0, 1.D0,-1.D0,-1.D0, | |
11162 | & 1.D0,-1.D0, 1.D0,-1.D0, | |
11163 | & 1.D0,-1.D0,-1.D0, 1.D0, | |
11164 | & 1.D0, 1.D0, 1.D0, 1.D0 / | |
11165 | DATA EXPFAC / 1.D0, 1.D0, 1.D0, 1.D0, | |
11166 | & 1.D0,-1.D0,-1.D0, 1.D0, | |
11167 | & -1.D0, 1.D0,-1.D0, 1.D0, | |
11168 | & -1.D0,-1.D0, 1.D0, 1.D0 / | |
11169 | DATA IELTAB / 1, 2, 3, 4, | |
11170 | & 2, 1, 4, 3, | |
11171 | & 3, 4, 1, 2, | |
11172 | & 4, 3, 2, 1 / | |
11173 | ||
11174 | IF(IDEB(86).GE.20) WRITE(LO,'(1X,A,E12.3)') | |
11175 | & 'PHO_CHAN2A: impact parameter B',BB | |
11176 | ||
11177 | B24 = BB**2/4.D0 | |
11178 | DO 25 I=1,4 | |
11179 | AB(1,I) = ZXP(1,I)*EXP(-B24/BXP(1,I)) | |
11180 | & +ZXR(1,I)*EXP(-B24/BXR(1,I)) | |
11181 | AB(2,I) = ZXH(1,I)*EXP(-B24/BXH(1,I)) | |
11182 | AB(3,I) =-ZXT1A(1,I)*EXP(-B24/BXT1A(1,I)) | |
11183 | AB(4,I) =-ZXT2A(1,I)*EXP(-B24/BXT2A(1,I)) | |
11184 | AB(5,I) =-ZXL(1,I)*EXP(-B24/BXL(1,I)) | |
11185 | & -ZXT1B(1,I)*EXP(-B24/BXT1B(1,I)) | |
11186 | & -ZXT2B(1,I)*EXP(-B24/BXT2B(1,I)) | |
11187 | AB(6,I) = ZXDPE(1,I)*EXP(-B24/BXDPE(1,I)) | |
11188 | AB(7,I) = ZXDPA(1,I)*EXP(-B24/BXDPA(1,I)) | |
11189 | AB(8,I) = ZXDPB(1,I)*EXP(-B24/BXDPB(1,I)) | |
11190 | AB(9,I) = ZXDPD(1,I)*EXP(-B24/BXDPD(1,I)) | |
11191 | 25 CONTINUE | |
11192 | ||
11193 | DO 50 I=1,4 | |
11194 | ABSUM(I) = 0.D0 | |
11195 | DO 75 II=9,1,-1 | |
11196 | ABSUM(I) = ABSUM(I) + AB(II,I) | |
11197 | 75 CONTINUE | |
11198 | 50 CONTINUE | |
11199 | IF(IDEB(86).GE.20) WRITE(LO,'(1X,A,4E12.3)') | |
11200 | & 'PHO_CHAN2A: ABSUM',ABSUM | |
11201 | ||
11202 | DO 100 I=1,4 | |
11203 | CHI(I) = 0.D0 | |
11204 | CHDS(I) = 0.D0 | |
11205 | CHDH(I) = 0.D0 | |
11206 | CHDA(I) = 0.D0 | |
11207 | CHDB(I) = 0.D0 | |
11208 | CHDD(I) = 0.D0 | |
11209 | CHDPE(I) = 0.D0 | |
11210 | CHDPA(I) = 0.D0 | |
11211 | CHDPB(I) = 0.D0 | |
11212 | CHDPD(I) = 0.D0 | |
11213 | AMPELA(I,0) = 0.D0 | |
11214 | AMPELA(I,9) = 0.D0 | |
11215 | DO 200 K=1,4 | |
11216 | AMPELA(I,K) = 0.D0 | |
11217 | AMPELA(I,K+4) = 0.D0 | |
11218 | AMPVM(I,K) = 0.D0 | |
11219 | CHI(I) = CHI(I) + CHIFAC(K,I)*ABSUM(K) | |
11220 | CHDS(I) = CHDS(I) + CHIFAC(K,I)*AB(1,K) | |
11221 | CHDH(I) = CHDH(I) + CHIFAC(K,I)*AB(2,K) | |
11222 | CHDA(I) = CHDA(I) + CHIFAC(K,I)*AB(3,K) | |
11223 | CHDB(I) = CHDB(I) + CHIFAC(K,I)*AB(4,K) | |
11224 | CHDD(I) = CHDD(I) + CHIFAC(K,I)*AB(5,K) | |
11225 | CHDPE(I) = CHDPE(I) + CHIFAC(K,I)*AB(6,K) | |
11226 | CHDPA(I) = CHDPA(I) + CHIFAC(K,I)*AB(7,K) | |
11227 | CHDPB(I) = CHDPB(I) + CHIFAC(K,I)*AB(8,K) | |
11228 | CHDPD(I) = CHDPD(I) + CHIFAC(K,I)*AB(9,K) | |
11229 | 200 CONTINUE | |
11230 | IF(CHI(I).LT.-DEPS) THEN | |
11231 | IF(IDEB(86).GE.0) THEN | |
11232 | WRITE(LO,'(1X,A,I3,2E12.3)') | |
11233 | & 'PHO_CHAN2A: neg.eigenvalue (I,B,CHI)',I,BB,CHI(I) | |
11234 | WRITE(LO,'(5X,A,5E12.3)') 'E,CHIs:',ECM,(ABSUM(K),K=1,4) | |
11235 | ENDIF | |
11236 | ENDIF | |
11237 | IF(ABS(CHI(I)).GT.200.D0) THEN | |
11238 | EX1CHI(I) = 0.D0 | |
11239 | EX2CHI(I) = 0.D0 | |
11240 | ELSE | |
11241 | TMP = EXP(-CHI(I)) | |
11242 | EX1CHI(I) = TMP | |
11243 | EX2CHI(I) = TMP*TMP | |
11244 | ENDIF | |
11245 | 100 CONTINUE | |
11246 | IF(IDEB(86).GE.20) THEN | |
11247 | WRITE(LO,'(1X,A,4E12.3)') 'PHO_CHAN2A: EX1CHI',EX1CHI | |
11248 | ENDIF | |
11249 | ||
11250 | AMPELA(1,0) = 4.D0 | |
11251 | DO 300 K=1,4 | |
11252 | DO 400 J=1,4 | |
11253 | CFAC = 2.D0*EXPFAC(J,K)*EX2CHI(J) | |
11254 | AMPELA(K,0) = AMPELA(K,0) - EXPFAC(J,K)*EX1CHI(J) | |
11255 | AMPELA(K,1) = AMPELA(K,1) + CFAC*CHDS(J) | |
11256 | AMPELA(K,2) = AMPELA(K,2) + CFAC*CHDH(J) | |
11257 | AMPELA(K,3) = AMPELA(K,3) - CFAC*CHDA(J) | |
11258 | AMPELA(K,4) = AMPELA(K,4) - CFAC*CHDB(J) | |
11259 | AMPELA(K,5) = AMPELA(K,5) - CFAC*CHDD(J) | |
11260 | AMPELA(K,6) = AMPELA(K,6) + CFAC*CHDPE(J) | |
11261 | AMPELA(K,7) = AMPELA(K,7) + CFAC*CHDPA(J) | |
11262 | AMPELA(K,8) = AMPELA(K,8) + CFAC*CHDPB(J) | |
11263 | AMPELA(K,9) = AMPELA(K,9) + CFAC*CHDPD(J) | |
11264 | 400 CONTINUE | |
11265 | 300 CONTINUE | |
11266 | ||
11267 | IF(IDEB(86).GE.25) THEN | |
11268 | DO 305 I=1,9 | |
11269 | WRITE(LO,'(1X,A,I3,4E10.3)') 'PHO_CHAN2A: AMPELA(1-4,I)',I, | |
11270 | & (AMPELA(K,1),K=1,4) | |
11271 | 305 CONTINUE | |
11272 | ENDIF | |
11273 | ||
11274 | C VDM factors --> amplitudes | |
11275 | C low mass excitations | |
11276 | DO 500 I=1,4 | |
11277 | AMPCHA(I) = 0.D0 | |
11278 | DO 600 K=1,4 | |
11279 | AMPCHA(I) = AMPCHA(I) + AMPFAC(K)*AMPELA(IELTAB(K,I),0) | |
11280 | 600 CONTINUE | |
11281 | 500 CONTINUE | |
11282 | AMPVME = AMPCHA(1)/EIGHT | |
11283 | AMLMSD(1) = AMPCHA(2)/EIGHT | |
11284 | AMLMSD(2) = AMPCHA(3)/EIGHT | |
11285 | AMLMDD = AMPCHA(4)/EIGHT | |
11286 | C elastic part, high mass diffraction | |
11287 | AMPEL = 0.5D0*ZXD(1,1)*EXP(-B24/BXD(1,1)) | |
11288 | AMPSOF = 0.D0 | |
11289 | AMPHAR = 0.D0 | |
11290 | AMHMSD(1) = 0.D0 | |
11291 | AMHMSD(2) = 0.D0 | |
11292 | AMHMDD = 0.D0 | |
11293 | AMPDP(1) = 0.D0 | |
11294 | AMPDP(2) = 0.D0 | |
11295 | AMPDP(3) = 0.D0 | |
11296 | AMPDP(4) = 0.D0 | |
11297 | DO 450 I=1,4 | |
11298 | AMPEL = AMPEL + ELAFAC(I)*AMPELA(I,0)/8.D0 | |
11299 | AMPSOF = AMPSOF + ELAFAC(I)*AMPELA(I,1) | |
11300 | AMPHAR = AMPHAR + ELAFAC(I)*AMPELA(I,2) | |
11301 | AMHMSD(1) = AMHMSD(1) + ELAFAC(I)*AMPELA(I,3) | |
11302 | AMHMSD(2) = AMHMSD(2) + ELAFAC(I)*AMPELA(I,4) | |
11303 | AMHMDD = AMHMDD + ELAFAC(I)*AMPELA(I,5) | |
11304 | AMPDP(1) = AMPDP(1) + ELAFAC(I)*AMPELA(I,6) | |
11305 | AMPDP(2) = AMPDP(2) + ELAFAC(I)*AMPELA(I,7) | |
11306 | AMPDP(3) = AMPDP(3) + ELAFAC(I)*AMPELA(I,8) | |
11307 | AMPDP(4) = AMPDP(4) + ELAFAC(I)*AMPELA(I,9) | |
11308 | 450 CONTINUE | |
11309 | AMPSOF = AMPSOF/16.D0 | |
11310 | AMPHAR = AMPHAR/16.D0 | |
11311 | AMHMSD(1) = AMHMSD(1)/16.D0 | |
11312 | AMHMSD(2) = AMHMSD(2)/16.D0 | |
11313 | AMHMDD = AMHMDD/16.D0 | |
11314 | AMPDP(1) = AMPDP(1)/16.D0 | |
11315 | AMPDP(2) = AMPDP(2)/16.D0 | |
11316 | AMPDP(3) = AMPDP(3)/16.D0 | |
11317 | AMPDP(4) = AMPDP(4)/16.D0 | |
11318 | IF(DREAL(AMHMSD(1)).LE.0.D0) AMHMSD(1) = 0.D0 | |
11319 | IF(DREAL(AMHMSD(2)).LE.0.D0) AMHMSD(2) = 0.D0 | |
11320 | IF(DREAL(AMHMDD).LE.0.D0) AMHMDD = 0.D0 | |
11321 | IF(DREAL(AMPDP(1)).LE.0.D0) AMPDP(1) = 0.D0 | |
11322 | IF(DREAL(AMPDP(2)).LE.0.D0) AMPDP(2) = 0.D0 | |
11323 | IF(DREAL(AMPDP(3)).LE.0.D0) AMPDP(3) = 0.D0 | |
11324 | IF(DREAL(AMPDP(4)).LE.0.D0) AMPDP(4) = 0.D0 | |
11325 | ||
11326 | C vector-meson production, weight factors | |
11327 | IF((IFPAP(1).EQ.22).OR.(IFPAP(2).EQ.22)) THEN | |
11328 | IF(IFPAP(1).EQ.22) THEN | |
11329 | IF(IFPAP(2).EQ.22) THEN | |
11330 | DO 10 I=1,4 | |
11331 | DO 15 J=1,4 | |
11332 | AMPVM(I,J) = PARMDL(9+I)*PARMDL(9+J)*AMPVME | |
11333 | 15 CONTINUE | |
11334 | 10 CONTINUE | |
11335 | ELSE | |
11336 | AMPVM(1,1) = PARMDL(10)*AMPVME | |
11337 | AMPVM(2,1) = PARMDL(11)*AMPVME | |
11338 | AMPVM(3,1) = PARMDL(12)*AMPVME | |
11339 | AMPVM(4,1) = PARMDL(13)*AMPVME | |
11340 | ENDIF | |
11341 | ELSE IF(IFPAP(2).EQ.22) THEN | |
11342 | AMPVM(1,1) = PARMDL(10)*AMPVME | |
11343 | AMPVM(1,2) = PARMDL(11)*AMPVME | |
11344 | AMPVM(1,3) = PARMDL(12)*AMPVME | |
11345 | AMPVM(1,4) = PARMDL(13)*AMPVME | |
11346 | ENDIF | |
11347 | ENDIF | |
11348 | C debug output | |
11349 | IF(IDEB(86).GE.5) THEN | |
11350 | WRITE(LO,'(/,1X,A)') | |
11351 | & 'PHO_CHAN2A: impact parameter amplitudes' | |
11352 | WRITE(LO,'(1X,A,1P,2E12.3)') ' AMPEL',AMPEL | |
11353 | WRITE(LO,'(1X,A,1P,8E10.3)') 'AMPVM(1,1-4)',(AMPVM(1,K),K=1,4) | |
11354 | WRITE(LO,'(1X,A,1P,8E10.3)') 'AMPVM(2,1-4)',(AMPVM(2,K),K=1,4) | |
11355 | WRITE(LO,'(1X,A,1P,8E10.3)') 'AMPVM(3,1-4)',(AMPVM(3,K),K=1,4) | |
11356 | WRITE(LO,'(1X,A,1P,8E10.3)') 'AMPVM(4,1-4)',(AMPVM(4,K),K=1,4) | |
11357 | WRITE(LO,'(1X,A,1P,4E12.3)') ' AMPSOF/HAR',AMPSOF,AMPHAR | |
11358 | WRITE(LO,'(1X,A,1P,4E12.3)') ' AMLMSD',AMLMSD | |
11359 | WRITE(LO,'(1X,A,1P,4E12.3)') ' AMHMSD',AMHMSD | |
11360 | WRITE(LO,'(1X,A,1P,2E12.3)') ' AMLMDD',AMLMDD | |
11361 | WRITE(LO,'(1X,A,1P,2E12.3)') ' AMHMDD',AMHMDD | |
11362 | WRITE(LO,'(1X,A,1P,8E10.3)') ' AMPDP(1-4)',AMPDP | |
11363 | ENDIF | |
11364 | ||
11365 | END | |
11366 | ||
11367 | *$ CREATE PHO_EVENT.FOR | |
11368 | *COPY PHO_EVENT | |
11369 | CDECK ID>, PHO_EVENT | |
11370 | SUBROUTINE PHO_EVENT(NEV,P1,P2,FAC,IREJ) | |
11371 | C******************************************************************** | |
11372 | C | |
11373 | C main subroutine to manage simulation processes | |
11374 | C | |
11375 | C input: NEV -1 initialization | |
11376 | C 1 generation of events | |
11377 | C 2 generation of events without rejection | |
11378 | C due to energy dependent cross section | |
11379 | C 3 generation of events without rejection | |
11380 | C using initialization energy | |
11381 | C -2 output of event generation statistics | |
11382 | C P1(4) momentum of particle 1 (internal TARGET) | |
11383 | C P2(4) momentum of particle 2 (internal PROJECTILE) | |
11384 | C FAC used for initialization: | |
11385 | C contains cross section the events corresponds to | |
11386 | C during generation: current cross section | |
11387 | C | |
11388 | C output: IREJ 0: event accepted | |
11389 | C 1: event rejected | |
11390 | C | |
11391 | C******************************************************************** | |
11392 | IMPLICIT DOUBLE PRECISION (A-H,O-Z) | |
11393 | SAVE | |
11394 | ||
11395 | PARAMETER ( TINY = 1.D-10 ) | |
11396 | ||
11397 | DIMENSION P1(4),P2(4) | |
11398 | ||
11399 | C input/output channels | |
11400 | INTEGER LI,LO | |
11401 | COMMON /POINOU/ LI,LO | |
11402 | C event debugging information | |
11403 | INTEGER NMAXD | |
11404 | PARAMETER (NMAXD=100) | |
11405 | INTEGER IDEB,KSPOM,KHPOM,KSREG,KHDIR,KACCEP,KSTRG,KHTRG,KSLOO, | |
11406 | & KHLOO,KSDPO,KHDPO,KEVENT,KSOFT,KHARD | |
11407 | COMMON /PODEBG/ IDEB(NMAXD),KSPOM,KHPOM,KSREG,KHDIR,KACCEP,KSTRG, | |
11408 | & KHTRG,KSLOO,KHLOO,KSDPO,KHDPO,KEVENT,KSOFT,KHARD | |
11409 | C model switches and parameters | |
11410 | CHARACTER*8 MDLNA | |
11411 | INTEGER ISWMDL,IPAMDL | |
11412 | DOUBLE PRECISION PARMDL | |
11413 | COMMON /POMDLS/ MDLNA(50),ISWMDL(50),PARMDL(400),IPAMDL(400) | |
11414 | C general process information | |
11415 | INTEGER IPROCE,IDNODF,IDIFR1,IDIFR2,IDDPOM,IPRON | |
11416 | COMMON /POPRCS/ IPROCE,IDNODF,IDIFR1,IDIFR2,IDDPOM,IPRON(15,4) | |
11417 | C internal rejection counters | |
11418 | INTEGER NMXJ | |
11419 | PARAMETER (NMXJ=60) | |
11420 | CHARACTER*10 REJTIT | |
11421 | INTEGER IFAIL | |
11422 | COMMON /POLOOP/ IFAIL(NMXJ),REJTIT(NMXJ) | |
11423 | C gamma-lepton or gamma-hadron vertex information | |
11424 | INTEGER IGHEL,IDPSRC,IDBSRC | |
11425 | DOUBLE PRECISION PINI,PFIN,PGAM,GYY,GQ2,GGECM,GAIMP,PFTHE,PFPHI, | |
11426 | & RADSRC,AMSRC,GAMSRC | |
11427 | COMMON /POFSRC/ PINI(5,2),PFIN(5,2),PGAM(5,2),IGHEL(2), | |
11428 | & GYY(2),GQ2(2),GGECM,GAIMP(2),PFTHE(2),PFPHI(2), | |
11429 | & IDPSRC(2),IDBSRC(2),RADSRC(2),AMSRC(2),GAMSRC(2) | |
11430 | C global event kinematics and particle IDs | |
11431 | INTEGER IFPAP,IFPAB | |
11432 | DOUBLE PRECISION ECM,PCM,PMASS,PVIRT | |
11433 | COMMON /POGCMS/ ECM,PCM,PMASS(2),PVIRT(2),IFPAP(2),IFPAB(2) | |
11434 | C cross sections | |
11435 | INTEGER IPFIL,IFAFIL,IFBFIL | |
11436 | DOUBLE PRECISION SIGTOT,SIGELA,SIGVM,SIGINE,SIGNDF,SIGDIR, | |
11437 | & SIGLSD,SIGHSD,SIGLDD,SIGHDD,SIGCDF, | |
11438 | & SIGPOM,SIGREG,SIGHAR,SIGTR1,SIGTR2,SIGLOO, | |
11439 | & SIGDPO,SIG1SO,SIG1HA,SLOEL,SLOVM,SIGCOR, | |
11440 | & FSUP,FSUD,FSUH,ECMFIL,P2AFIL,P2BFIL | |
11441 | COMMON /POCSEC/ SIGTOT,SIGELA,SIGVM(0:4,0:4),SIGINE,SIGNDF,SIGDIR, | |
11442 | & SIGLSD(2),SIGHSD(2),SIGLDD,SIGHDD,SIGCDF(0:4), | |
11443 | & SIGPOM,SIGREG,SIGHAR,SIGTR1(2),SIGTR2(2),SIGLOO, | |
11444 | & SIGDPO(4),SIG1SO,SIG1HA,SLOEL,SLOVM(4,4),SIGCOR, | |
11445 | & FSUP(2),FSUD(2),FSUH(2),ECMFIL,P2AFIL,P2BFIL, | |
11446 | & IPFIL,IFAFIL,IFBFIL | |
11447 | C event weights and generated cross section | |
11448 | INTEGER IPOWGC,ISWCUT,IVWGHT | |
11449 | DOUBLE PRECISION SIGGEN,HSWGHT,HSWCUT,EVWGHT | |
11450 | COMMON /POWGHT/ SIGGEN(4),HSWGHT(0:10),HSWCUT(20),EVWGHT(0:10), | |
11451 | & IPOWGC(0:10),ISWCUT(20),IVWGHT(0:10) | |
11452 | C names of hard scattering processes | |
11453 | INTEGER Max_pro_1 | |
11454 | PARAMETER ( Max_pro_1 = 16 ) | |
11455 | CHARACTER*18 PROC | |
11456 | COMMON /POHPRO/ PROC(0:Max_pro_1) | |
11457 | C hard cross sections and MC selection weights | |
11458 | INTEGER Max_pro_2 | |
11459 | PARAMETER ( Max_pro_2 = 16 ) | |
11460 | INTEGER IHa_last,IHb_last,MH_pro_on,MH_tried, | |
11461 | & MH_acc_1,MH_acc_2 | |
11462 | DOUBLE PRECISION Hfac,HWgx,HSig,Hdpt,HEcm_last,HQ2a_last,HQ2b_last | |
11463 | COMMON /POHRCS/ Hfac(-1:Max_pro_2),HWgx(-1:Max_pro_2), | |
11464 | & HSig(-1:Max_pro_2),Hdpt(-1:Max_pro_2), | |
11465 | & HEcm_last,HQ2a_last,HQ2b_last,IHa_last,IHb_last, | |
11466 | & MH_pro_on(-1:Max_pro_2,0:4),MH_tried(-1:Max_pro_2,0:4), | |
11467 | & MH_acc_1(-1:Max_pro_2,0:4),MH_acc_2(-1:Max_pro_2,0:4) | |
11468 | C table of particle indices for recursive PHOJET calls | |
11469 | INTEGER MAXIPX | |
11470 | PARAMETER ( MAXIPX = 100 ) | |
11471 | INTEGER IPOPOS,IPORES,IPOIX1,IPOIX2,IPOIX3 | |
11472 | COMMON /PORECU/ IPOPOS(2,MAXIPX),IPORES(MAXIPX), | |
11473 | & IPOIX1,IPOIX2,IPOIX3 | |
11474 | ||
11475 | DIMENSION IPRSAM(10),IPRACC(10),IENACC(10),IDNS(4),IDNA(4) | |
11476 | ||
11477 | IREJ = 0 | |
11478 | ||
11479 | C initializations | |
11480 | IF(NEV.EQ.-1) THEN | |
11481 | WRITE(LO,'(/3(/1X,A))') | |
11482 | & '=======================================================', | |
11483 | & ' ------- initialization of event generation --------', | |
11484 | & '=======================================================' | |
11485 | CALL PHO_SETMDL(0,0,-2) | |
11486 | C amplitude parameters | |
11487 | CALL PHO_FITPAR(1) | |
11488 | CALL PHO_REJSTA(-1) | |
11489 | C initialize MC package | |
11490 | CALL PHO_EVEINI(1,P1,P2,JM1,JM2) | |
11491 | CALL PHO_MCINI | |
11492 | CALL PHO_SAMPRO(1,IFPAP(1),IFPAP(2),ECM,PVIRT(1),PVIRT(2), | |
11493 | & 0.D0,-1) | |
11494 | CALL PHO_PARTON(-1,0,0,P1,P2,IREJ) | |
11495 | C cross section | |
11496 | FAC = SIGGEN(4) | |
11497 | DO 20 I=1,10 | |
11498 | IPRSAM(I) = 0 | |
11499 | IPRACC(I) = 0 | |
11500 | IENACC(I) = 0 | |
11501 | 20 CONTINUE | |
11502 | ISPS = 0 | |
11503 | ISPA = 0 | |
11504 | ISRS = 0 | |
11505 | ISRA = 0 | |
11506 | IHPS = 0 | |
11507 | IHPA = 0 | |
11508 | ISTS = 0 | |
11509 | ISTA = 0 | |
11510 | ISLS = 0 | |
11511 | ISLA = 0 | |
11512 | IDIS = 0 | |
11513 | IDIA = 0 | |
11514 | IDPS = 0 | |
11515 | IDPA = 0 | |
11516 | IDNS(1) = 0 | |
11517 | IDNS(2) = 0 | |
11518 | IDNS(3) = 0 | |
11519 | IDNS(4) = 0 | |
11520 | IDNA(1) = 0 | |
11521 | IDNA(2) = 0 | |
11522 | IDNA(3) = 0 | |
11523 | IDNA(4) = 0 | |
11524 | KACCEP = 0 | |
11525 | KEVENT = 0 | |
11526 | KEVGEN = 0 | |
11527 | ECMSUM = 0.D0 | |
11528 | ELSE IF(NEV.GT.0) THEN | |
11529 | C | |
11530 | C -------------- begin event generation --------------- | |
11531 | C | |
11532 | IPAMDL(13) = 0 | |
11533 | IF(NEV.EQ.3) IPAMDL(13) = 1 | |
11534 | KEVENT = KEVENT+1 | |
11535 | C enable debugging | |
11536 | CALL PHO_TRACE(0,0,0) | |
11537 | IF(IDEB(68).GE.2) THEN | |
11538 | IF((MOD(KEVENT,50).EQ.0).OR.(IDEB(68).GE.3)) | |
11539 | & WRITE(LO,'(1X,A,2I12)') 'call to PHO_EVENT no',KEVENT,KACCEP | |
11540 | ENDIF | |
11541 | CALL PHO_EVEINI(0,P1,P2,JM1,JM2) | |
11542 | C cross section calculation | |
11543 | FAC = SIGGEN(3) | |
11544 | IF(NEV.EQ.1) THEN | |
11545 | IF(IVWGHT(1).EQ.1) THEN | |
11546 | WG = EVWGHT(1)*SIGGEN(3)/SIGGEN(4) | |
11547 | ELSE | |
11548 | WG = SIGGEN(3)/SIGGEN(4) | |
11549 | ENDIF | |
11550 | IF(DT_RNDM(FAC).GT.WG) THEN | |
11551 | IREJ = 1 | |
11552 | IF(IDEB(68).GE.6) THEN | |
11553 | WRITE(LO,'(1X,2A,/5X,2I10,6X,1P3E10.3)') | |
11554 | & 'PHO_EVENT: rejection due to cross section', | |
11555 | & ' (CALL/ACC/EVWGHT(1)/SIG/SIGMAX)', | |
11556 | & KEVENT,KACCEP,EVWGHT(1),SIGGEN(3),SIGGEN(4) | |
11557 | CALL PHO_PREVNT(-1) | |
11558 | ENDIF | |
11559 | RETURN | |
11560 | ENDIF | |
11561 | ENDIF | |
11562 | KEVGEN = KEVGEN+1 | |
11563 | SIGGEN(1) = SIGGEN(4)*DBLE(KEVGEN)/DBLE(KEVENT) | |
11564 | HSWGHT(0) = MAX(1.D0,WG) | |
11565 | ||
11566 | ITRY1 = 0 | |
11567 | 50 CONTINUE | |
11568 | ITRY1 = ITRY1+1 | |
11569 | IF(ITRY1.GT.1) CALL PHO_EVEINI(2,P1,P2,JM1,JM2) | |
11570 | ||
11571 | C sample process | |
11572 | IPROCE = 0 | |
11573 | CALL PHO_SAMPRO(1,IFPAP(1),IFPAP(2),ECM,PVIRT(1),PVIRT(2), | |
11574 | & 1.D0,IPROCE) | |
11575 | IF(IPROCE.EQ.0) THEN | |
11576 | IF(IDEB(68).GE.4) WRITE(LO,'(1X,A)') 'PHO_EVENT: ', | |
11577 | & 'rejection by PHO_SAMPRO (call,Ecm)',KEVENT,ECM | |
11578 | IREJ = 50 | |
11579 | RETURN | |
11580 | ENDIF | |
11581 | C sampling statistics | |
11582 | IPRSAM(IPROCE) = IPRSAM(IPROCE)+1 | |
11583 | ||
11584 | ITRY2 = 0 | |
11585 | 60 CONTINUE | |
11586 | ITRY2 = ITRY2+1 | |
11587 | IF(ITRY2.GT.1) CALL PHO_EVEINI(2,P1,P2,JM1,JM2) | |
11588 | C sample number of cut graphs according to IPROCE and | |
11589 | C generate parton configurations+strings | |
11590 | CALL PHO_PARTON(IPROCE,JM1,JM2,P1,P2,IREJ) | |
11591 | C collect statistics | |
11592 | ISPS = ISPS+KSPOM | |
11593 | IHPS = IHPS+KHPOM | |
11594 | ISRS = ISRS+KSREG | |
11595 | ISTS = ISTS+KSTRG+KHTRG | |
11596 | ISLS = ISLS+KSLOO+KHLOO | |
11597 | IDIS = IDIS+MIN(KHDIR,1) | |
11598 | IDPS = IDPS+KHDPO+KSDPO | |
11599 | IF((IDIFR1+IDIFR2+IDDPOM.EQ.0).AND.(KHDIR.GT.0)) | |
11600 | & IDNS(KHDIR) = IDNS(KHDIR)+1 | |
11601 | C rejection? | |
11602 | IF(IREJ.NE.0) THEN | |
11603 | IF(IDEB(68).GE.4) THEN | |
11604 | WRITE(LO,'(/1X,A,2I5)') | |
11605 | & 'PHO_EVENT: rejection by PHO_PARTON',ITRY2,IREJ | |
11606 | CALL PHO_PREVNT(-1) | |
11607 | ENDIF | |
11608 | IF((IREJ.EQ.50).AND.(NEV.EQ.1)) THEN | |
11609 | RETURN | |
11610 | ENDIF | |
11611 | IFAIL(1) = IFAIL(1)+1 | |
11612 | IF(ITRY1.GT.5) RETURN | |
11613 | IF(IREJ.GE.5) THEN | |
11614 | IF(ISWMDL(2).EQ.0) RETURN | |
11615 | GOTO 50 | |
11616 | ENDIF | |
11617 | IF(ITRY2.LT.5) GOTO 60 | |
11618 | GOTO 50 | |
11619 | ENDIF | |
11620 | C fragmentation of strings | |
11621 | C FSR and string fragmentation is done separately by DPMJET routines | |
11622 | C CALL PHO_STRFRA(IREJ) | |
11623 | C rejection? | |
11624 | IF(IREJ.NE.0) THEN | |
11625 | IFAIL(23) = IFAIL(23)+1 | |
11626 | IF(IDEB(68).GE.4) THEN | |
11627 | WRITE(LO,'(/1X,A,2I5)') | |
11628 | & 'PHO_EVENT: rejection by PHO_STRFRA',ITRY2,IREJ | |
11629 | CALL PHO_PREVNT(-1) | |
11630 | ENDIF | |
11631 | GOTO 50 | |
11632 | ENDIF | |
11633 | C check of conservation of quantum numbers | |
11634 | IF(IDEB(68).GE.-5) THEN | |
11635 | CALL PHO_CHECK(-1,IREJ) | |
11636 | IF(IREJ.NE.0) GOTO 50 | |
11637 | ENDIF | |
11638 | C event now completely processed and accepted | |
11639 | C acceptance statistics | |
11640 | IPRACC(IPROCE) = IPRACC(IPROCE)+1 | |
11641 | ISPA = ISPA+KSPOM | |
11642 | IHPA = IHPA+KHPOM | |
11643 | ISRA = ISRA+KSREG | |
11644 | ISTA = ISTA+(KSTRG+KHTRG) | |
11645 | ISLA = ISLA+(KSLOO+KHLOO) | |
11646 | IDIA = IDIA+MIN(KHDIR,1) | |
11647 | IDPA = IDPA+KHDPO+KSDPO | |
11648 | IF((IDIFR1+IDIFR2.EQ.0).AND.(KHDIR.GT.0)) | |
11649 | & IDNA(KHDIR) = IDNA(KHDIR)+1 | |
11650 | DO 55 I=1,IPOIX2 | |
11651 | IENACC(IPORES(I)) = IENACC(IPORES(I))+1 | |
11652 | 55 CONTINUE | |
11653 | KACCEP = KACCEP+1 | |
11654 | ||
11655 | C debug output (partial / full event listing) | |
11656 | if((IDEB(68).eq.1).and.(MOD(KACCEP,50).EQ.0)) | |
11657 | & WRITE(LO,'(1X,A,2I12)') 'call to PHO_EVENT no',KEVENT,KACCEP | |
11658 | IF(IDEB(67).GE.10) THEN | |
11659 | IF(IDEB(67).LE.15) THEN | |
11660 | CALL PHO_PREVNT(-1) | |
11661 | ELSE IF(IDEB(67).LE.20) THEN | |
11662 | CALL PHO_PREVNT(0) | |
11663 | ELSE IF(IDEB(67).LE.25) THEN | |
11664 | CALL PHO_PREVNT(1) | |
11665 | ELSE | |
11666 | CALL PHO_PREVNT(2) | |
11667 | ENDIF | |
11668 | ENDIF | |
11669 | C | |
11670 | C effective weight | |
11671 | DO 65 I=1,10 | |
11672 | IF(IPOWGC(I).GT.0) THEN | |
11673 | HSWGHT(0) = HSWGHT(0)*HSWGHT(I) | |
11674 | ENDIF | |
11675 | 65 CONTINUE | |
11676 | IF(IVWGHT(1).EQ.1) THEN | |
11677 | WG = HSWGHT(0) | |
11678 | IF(WG.GT.1.01D0) THEN | |
11679 | IF(EVWGHT(1).LT.1.01D0) THEN | |
11680 | WRITE(LO,'(1X,A,2I12,1PE12.3)') | |
11681 | & 'PHO_EVENT: cross section weight > 1', | |
11682 | & KEVENT,KACCEP,WG | |
11683 | WRITE(LO,'(5X,A,1P3E11.3)') 'SIGCUR,SIGMAX,EVWGHT(1):', | |
11684 | & SIGGEN(3),SIGGEN(4),EVWGHT(1) | |
11685 | ENDIF | |
11686 | EVWGHT(1) = HSWGHT(0) | |
11687 | HSWGHT(0) = 1.D0 | |
11688 | ELSE | |
11689 | EVWGHT(1) = 1.D0 | |
11690 | ENDIF | |
11691 | ENDIF | |
11692 | ||
11693 | C effective cross section | |
11694 | SIGGEN(2) = SIGGEN(4)*DBLE(KACCEP)/DBLE(KEVENT) | |
11695 | ECMSUM = ECMSUM+ECM | |
11696 | SIGGEN(3) = SIGGEN(3)*HSWGHT(0) | |
11697 | ELSE IF(NEV.EQ.-2) THEN | |
11698 | ||
11699 | C ---------------- end of event generation ---------------------- | |
11700 | ||
11701 | WRITE(LO,'(/3(/1X,A),//1X,A,3I12,/1X,A,F12.1)') | |
11702 | & '====================================================', | |
11703 | & ' --------- summary of event generation ----------', | |
11704 | & '====================================================', | |
11705 | & 'called,generated,accepted events:',KEVENT,KEVGEN,KACCEP, | |
11706 | & 'average CMS energy:',ECMSUM/DBLE(MAX(1,KACCEP)) | |
11707 | ||
11708 | C write out statistics | |
11709 | IF(KACCEP.GT.0) THEN | |
11710 | ||
11711 | FAC1 = SIGGEN(4)/DBLE(KEVENT) | |
11712 | FAC2 = FAC/DBLE(KACCEP) | |
11713 | WRITE(LO,'(/1X,A,/1X,A)') | |
11714 | & 'PHO_EVENT: generated and accepted events', | |
11715 | & '----------------------------------------' | |
11716 | WRITE(LO,'(3X,A)') | |
11717 | & 'process, sampled, accepted, cross section (internal/external)' | |
11718 | WRITE(LO,'(3X,A,2I12,1P2E13.3)') 'non.diff.',IPRSAM(1), | |
11719 | & IPRACC(1),DBLE(IPRACC(1))*FAC1,DBLE(IPRACC(1))*FAC2 | |
11720 | WRITE(LO,'(3X,A,2I12,1P2E13.3)') 'elas sca.',IPRSAM(2), | |
11721 | & IPRACC(2),DBLE(IPRACC(2))*FAC1,DBLE(IPRACC(2))*FAC2 | |
11722 | WRITE(LO,'(3X,A,2I12,1P2E13.3)') 'qela sca.',IPRSAM(3), | |
11723 | & IPRACC(3),DBLE(IPRACC(3))*FAC1,DBLE(IPRACC(3))*FAC2 | |
11724 | WRITE(LO,'(3X,A,2I12,1P2E13.3)') 'doub.pom.',IPRSAM(4), | |
11725 | & IPRACC(4),DBLE(IPRACC(4))*FAC1,DBLE(IPRACC(4))*FAC2 | |
11726 | WRITE(LO,'(3X,A,2I12,1P2E13.3)') 'diff.par1',IPRSAM(5), | |
11727 | & IPRACC(5),DBLE(IPRACC(5))*FAC1,DBLE(IPRACC(5))*FAC2 | |
11728 | WRITE(LO,'(3X,A,2I12,1P2E13.3)') 'diff.par2',IPRSAM(6), | |
11729 | & IPRACC(6),DBLE(IPRACC(6))*FAC1,DBLE(IPRACC(6))*FAC2 | |
11730 | WRITE(LO,'(3X,A,2I12,1P2E13.3)') 'doub.dif.',IPRSAM(7), | |
11731 | & IPRACC(7),DBLE(IPRACC(7))*FAC1,DBLE(IPRACC(7))*FAC2 | |
11732 | WRITE(LO,'(3X,A,2I12,1P2E13.3)') 'dir all ',IPRSAM(8), | |
11733 | & IPRACC(8),DBLE(IPRACC(8))*FAC1,DBLE(IPRACC(8))*FAC2 | |
11734 | WRITE(LO,'(3X,A,2I12,1P2E13.3)') 'dir X res',IDNS(1),IDNA(1), | |
11735 | & DBLE(IDNA(1))*FAC1,DBLE(IDNA(1))*FAC2 | |
11736 | WRITE(LO,'(3X,A,2I12,1P2E13.3)') 'res X dir',IDNS(2),IDNA(2), | |
11737 | & DBLE(IDNA(2))*FAC1,DBLE(IDNA(2))*FAC2 | |
11738 | WRITE(LO,'(3X,A,2I12,1P2E13.3)') 'dir X dir',IDNS(3),IDNA(3), | |
11739 | & DBLE(IDNA(3))*FAC1,DBLE(IDNA(3))*FAC2 | |
11740 | WRITE(LO,'(3X,A,2I12,1P2E13.3)') 'soft pom.',ISPS,ISPA, | |
11741 | & DBLE(ISPA)*FAC1,DBLE(ISPA)*FAC2 | |
11742 | WRITE(LO,'(3X,A,2I12,1P2E13.3)') 'hard pom.',IHPS,IHPA, | |
11743 | & DBLE(IHPA)*FAC1,DBLE(IHPA)*FAC2 | |
11744 | WRITE(LO,'(3X,A,2I12,1P2E13.3)') 'soft reg.',ISRS,ISRA, | |
11745 | & DBLE(ISRA)*FAC1,DBLE(ISRA)*FAC2 | |
11746 | WRITE(LO,'(3X,A,2I12,1P2E13.3)') 'enh. trg.',ISTS,ISTA, | |
11747 | & DBLE(ISTA)*FAC1,DBLE(ISTA)*FAC2 | |
11748 | WRITE(LO,'(3X,A,2I12,1P2E13.3)') 'enh. log.',ISLS,ISLA, | |
11749 | & DBLE(ISLA)*FAC1,DBLE(ISLA)*FAC2 | |
11750 | WRITE(LO,'(3X,A,2I12,1P2E13.3)') 'doub.pom.',IDPS,IDPA, | |
11751 | & DBLE(IDPA)*FAC1,DBLE(IDPA)*FAC2 | |
11752 | IF(ISWMDL(14).GT.0) THEN | |
11753 | WRITE(LO,'(3X,A,I3)') 'recursive pomeron splitting:', | |
11754 | & ISWMDL(14) | |
11755 | WRITE(LO,'(5X,A,I12)') '1->2pom-cut :',IENACC(8) | |
11756 | WRITE(LO,'(5X,A,I12)') '1->doub-pom :',IENACC(4) | |
11757 | WRITE(LO,'(5X,A,I12)') '1->diff-dis1:',IENACC(5) | |
11758 | WRITE(LO,'(5X,A,I12)') '1->diff-dis2:',IENACC(6) | |
11759 | WRITE(LO,'(5X,A,I12)') '1->doub-diff:',IENACC(7) | |
11760 | ENDIF | |
11761 | WRITE(LO,'(2(/1X,A,1PE12.3)/)') ' sampled cross section (mb)', | |
11762 | & SIGGEN(1),'accepted cross section (mb)',SIGGEN(2) | |
11763 | ||
11764 | CALL PHO_REJSTA(-2) | |
11765 | CALL PHO_SAMPRO(1,IFPAP(1),IFPAP(2),ECM,PVIRT(1),PVIRT(2), | |
11766 | & 0.D0,-2) | |
11767 | CALL PHO_PARTON(-2,0,0,P1,P2,IREJ) | |
11768 | C statistics of hard scattering processes | |
11769 | WRITE(LO,'(2(/1X,A))') | |
11770 | & 'PHO_EVENT: statistics of hard scattering processes', | |
11771 | & '--------------------------------------------------' | |
11772 | DO 43 K=1,4 | |
11773 | IF(MH_tried(0,K).GT.0) THEN | |
11774 | WRITE(LO,'(/5X,A,I3)') | |
11775 | & 'process (accepted,x-section internal/external) for IP:',K | |
11776 | DO 47 M=0,Max_pro_2 | |
11777 | WRITE(LO,'(1X,I3,1X,A,2X,2I12,1P2E13.3)') M,PROC(M), | |
11778 | & MH_tried(M,K),MH_acc_1(M,K),DBLE(MH_acc_1(M,K))*FAC1, | |
11779 | & DBLE(MH_acc_2(M,K))*FAC2 | |
11780 | 47 CONTINUE | |
11781 | ENDIF | |
11782 | 43 CONTINUE | |
11783 | ||
11784 | ELSE | |
11785 | WRITE(LO,'(/1X,A,I4,/)') 'no output of statistics',KEVENT | |
11786 | ENDIF | |
11787 | WRITE(LO,'(/3(/1X,A)/)') | |
11788 | & '======================================================', | |
11789 | & ' ------- end of event generation summary --------', | |
11790 | & '======================================================' | |
11791 | ELSE | |
11792 | WRITE(LO,'(/1X,A,I7)') 'PHO_EVENT:ERROR: unsupported NEV',NEV | |
11793 | ENDIF | |
11794 | ||
11795 | END | |
11796 | ||
11797 | *$ CREATE PHO_PARTON.FOR | |
11798 | *COPY PHO_PARTON | |
11799 | CDECK ID>, PHO_PARTON | |
11800 | SUBROUTINE PHO_PARTON(IPROC,JM1,JM2,P1,P2,IREJ) | |
11801 | C******************************************************************** | |
11802 | C | |
11803 | C calculation of complete parton configuration | |
11804 | C | |
11805 | C input: IPROC process ID 1 nondiffractive | |
11806 | C 2 elastic | |
11807 | C 3 quasi-ela. rho,omega,phi prod. | |
11808 | C 4 double Pomeron | |
11809 | C 5 single diff 1 | |
11810 | C 6 single diff 2 | |
11811 | C 7 double diff diss. | |
11812 | C 8 single-resolved / direct photon | |
11813 | C JM1,2 index of mother particles in /POEVT1/ | |
11814 | C | |
11815 | C | |
11816 | C output: complete parton configuration in /POEVT1/ | |
11817 | C IREJ 1 failure | |
11818 | C 0 success | |
11819 | C 50 rejection due to user cutoffs | |
11820 | C | |
11821 | C******************************************************************** | |
11822 | IMPLICIT DOUBLE PRECISION (A-H,O-Z) | |
11823 | SAVE | |
11824 | ||
11825 | DIMENSION P1(4),P2(4) | |
11826 | ||
11827 | PARAMETER ( TINY = 1.D-10 ) | |
11828 | ||
11829 | C input/output channels | |
11830 | INTEGER LI,LO | |
11831 | COMMON /POINOU/ LI,LO | |
11832 | C event debugging information | |
11833 | INTEGER NMAXD | |
11834 | PARAMETER (NMAXD=100) | |
11835 | INTEGER IDEB,KSPOM,KHPOM,KSREG,KHDIR,KACCEP,KSTRG,KHTRG,KSLOO, | |
11836 | & KHLOO,KSDPO,KHDPO,KEVENT,KSOFT,KHARD | |
11837 | COMMON /PODEBG/ IDEB(NMAXD),KSPOM,KHPOM,KSREG,KHDIR,KACCEP,KSTRG, | |
11838 | & KHTRG,KSLOO,KHLOO,KSDPO,KHDPO,KEVENT,KSOFT,KHARD | |
11839 | C model switches and parameters | |
11840 | CHARACTER*8 MDLNA | |
11841 | INTEGER ISWMDL,IPAMDL | |
11842 | DOUBLE PRECISION PARMDL | |
11843 | COMMON /POMDLS/ MDLNA(50),ISWMDL(50),PARMDL(400),IPAMDL(400) | |
11844 | C table of particle indices for recursive PHOJET calls | |
11845 | INTEGER MAXIPX | |
11846 | PARAMETER ( MAXIPX = 100 ) | |
11847 | INTEGER IPOPOS,IPORES,IPOIX1,IPOIX2,IPOIX3 | |
11848 | COMMON /PORECU/ IPOPOS(2,MAXIPX),IPORES(MAXIPX), | |
11849 | & IPOIX1,IPOIX2,IPOIX3 | |
11850 | C general process information | |
11851 | INTEGER IPROCE,IDNODF,IDIFR1,IDIFR2,IDDPOM,IPRON | |
11852 | COMMON /POPRCS/ IPROCE,IDNODF,IDIFR1,IDIFR2,IDDPOM,IPRON(15,4) | |
11853 | C global event kinematics and particle IDs | |
11854 | INTEGER IFPAP,IFPAB | |
11855 | DOUBLE PRECISION ECM,PCM,PMASS,PVIRT | |
11856 | COMMON /POGCMS/ ECM,PCM,PMASS(2),PVIRT(2),IFPAP(2),IFPAB(2) | |
11857 | C cross sections | |
11858 | INTEGER IPFIL,IFAFIL,IFBFIL | |
11859 | DOUBLE PRECISION SIGTOT,SIGELA,SIGVM,SIGINE,SIGNDF,SIGDIR, | |
11860 | & SIGLSD,SIGHSD,SIGLDD,SIGHDD,SIGCDF, | |
11861 | & SIGPOM,SIGREG,SIGHAR,SIGTR1,SIGTR2,SIGLOO, | |
11862 | & SIGDPO,SIG1SO,SIG1HA,SLOEL,SLOVM,SIGCOR, | |
11863 | & FSUP,FSUD,FSUH,ECMFIL,P2AFIL,P2BFIL | |
11864 | COMMON /POCSEC/ SIGTOT,SIGELA,SIGVM(0:4,0:4),SIGINE,SIGNDF,SIGDIR, | |
11865 | & SIGLSD(2),SIGHSD(2),SIGLDD,SIGHDD,SIGCDF(0:4), | |
11866 | & SIGPOM,SIGREG,SIGHAR,SIGTR1(2),SIGTR2(2),SIGLOO, | |
11867 | & SIGDPO(4),SIG1SO,SIG1HA,SLOEL,SLOVM(4,4),SIGCOR, | |
11868 | & FSUP(2),FSUD(2),FSUH(2),ECMFIL,P2AFIL,P2BFIL, | |
11869 | & IPFIL,IFAFIL,IFBFIL | |
11870 | C event weights and generated cross section | |
11871 | INTEGER IPOWGC,ISWCUT,IVWGHT | |
11872 | DOUBLE PRECISION SIGGEN,HSWGHT,HSWCUT,EVWGHT | |
11873 | COMMON /POWGHT/ SIGGEN(4),HSWGHT(0:10),HSWCUT(20),EVWGHT(0:10), | |
11874 | & IPOWGC(0:10),ISWCUT(20),IVWGHT(0:10) | |
11875 | C internal rejection counters | |
11876 | INTEGER NMXJ | |
11877 | PARAMETER (NMXJ=60) | |
11878 | CHARACTER*10 REJTIT | |
11879 | INTEGER IFAIL | |
11880 | COMMON /POLOOP/ IFAIL(NMXJ),REJTIT(NMXJ) | |
11881 | ||
11882 | IREJ = 0 | |
11883 | C clear event statistics | |
11884 | KSPOM = 0 | |
11885 | KHPOM = 0 | |
11886 | KSREG = 0 | |
11887 | KHDIR = 0 | |
11888 | KSTRG = 0 | |
11889 | KHTRG = 0 | |
11890 | KSLOO = 0 | |
11891 | KHLOO = 0 | |
11892 | KHARD = 0 | |
11893 | KSOFT = 0 | |
11894 | KSDPO = 0 | |
11895 | KHDPO = 0 | |
11896 | ||
11897 | C------------------------------------------------------------------- | |
11898 | C nondiffractive resolved processes | |
11899 | ||
11900 | IF(IPROC.EQ.1) THEN | |
11901 | C sample number of interactions | |
11902 | 555 CONTINUE | |
11903 | IINT = 0 | |
11904 | IP = 1 | |
11905 | C generate only hard events | |
11906 | IF(ISWMDL(2).EQ.0) THEN | |
11907 | MHPOM = 1 | |
11908 | MSPOM = 0 | |
11909 | MSREG = 0 | |
11910 | MHDIR = 0 | |
11911 | HSWGHT(1) = 1.D0 | |
11912 | ELSE | |
11913 | C minimum bias events | |
11914 | IPOWGC(1) = 0 | |
11915 | 10 CONTINUE | |
11916 | CALL PHO_SAMPRB(ECM,IP,IINT,JINT,KINT) | |
11917 | IPOWGC(1) = IPOWGC(1)+1 | |
11918 | MINT = 0 | |
11919 | MHDIR = 0 | |
11920 | MSTRG = 0 | |
11921 | MSLOO = 0 | |
11922 | C | |
11923 | C resolved soft processes: pomeron and reggeon | |
11924 | MSPOM = IINT | |
11925 | MSREG = JINT | |
11926 | C resolved hard process: hard pomeron | |
11927 | MHPOM = KINT | |
11928 | C resolved absorptive corrections | |
11929 | MPTRI = 0 | |
11930 | MPLOO = 0 | |
11931 | C restrictions given by user | |
11932 | IF(MSPOM.LT.ISWCUT(1)) GOTO 10 | |
11933 | IF(MSREG.LT.ISWCUT(2)) GOTO 10 | |
11934 | IF(MHPOM.LT.ISWCUT(3)) GOTO 10 | |
11935 | HSWGHT(1) = 1.D0/DBLE(IPOWGC(1)) | |
11936 | C ---------------------------- | |
11937 | IF(ISWMDL(15).EQ.0) THEN | |
11938 | MHPOM = 0 | |
11939 | IF(MSREG.GT.0) THEN | |
11940 | MSPOM = 0 | |
11941 | MSREG = 1 | |
11942 | ELSE | |
11943 | MSPOM = 1 | |
11944 | MSREG = 0 | |
11945 | ENDIF | |
11946 | ELSE IF(ISWMDL(15).EQ.1) THEN | |
11947 | IF(MHPOM.GT.0) THEN | |
11948 | MHPOM = 1 | |
11949 | MSPOM = 0 | |
11950 | MSREG = 0 | |
11951 | ELSE IF(MSPOM.GT.0) THEN | |
11952 | MSPOM = 1 | |
11953 | MSREG = 0 | |
11954 | ELSE | |
11955 | MSREG = 1 | |
11956 | ENDIF | |
11957 | ELSE IF(ISWMDL(15).EQ.2) THEN | |
11958 | MHPOM = MIN(1,MHPOM) | |
11959 | ELSE IF(ISWMDL(15).EQ.3) THEN | |
11960 | MSPOM = MIN(1,MSPOM) | |
11961 | ENDIF | |
11962 | ENDIF | |
11963 | C ---------------------------- | |
11964 | ||
11965 | C statistics | |
11966 | ISPS = ISPS+MSPOM | |
11967 | IHPS = IHPS+MHPOM | |
11968 | ISRS = ISRS+MSREG | |
11969 | ISTS = ISTS+MSTRG | |
11970 | ISLS = ISLS+MSLOO | |
11971 | ||
11972 | IF(IDEB(3).GE.5) WRITE(LO,'(1X,A,I10,I7,6I4)') | |
11973 | & 'PHO_PARTON: EV,SP,SR,HP,HD,ET,EL', | |
11974 | & KEVENT,MSPOM,MSREG,MHPOM,MHDIR,MPTRI,MPLOO | |
11975 | ||
11976 | ITRY2 = 0 | |
11977 | 50 CONTINUE | |
11978 | ITRY2 = ITRY2+1 | |
11979 | IF(ITRY2.GT.1) CALL PHO_EVEINI(2,P1,P2,JM1,JM2) | |
11980 | KSPOM = MSPOM | |
11981 | KSREG = MSREG | |
11982 | KHPOM = MHPOM | |
11983 | KHDIR = MHDIR | |
11984 | KSTRG = MPTRI | |
11985 | KSLOO = MPLOO | |
11986 | ||
11987 | CALL PHO_STDPAR(JM1,JM2,1,MSPOM,MSREG,MHPOM,MHDIR,IREJ) | |
11988 | IF(IREJ.NE.0) THEN | |
11989 | IF(IREJ.EQ.50) RETURN | |
11990 | IF(IDEB(3).GE.2) THEN | |
11991 | WRITE(LO,'(/1X,A,I5)') | |
11992 | & 'PHO_PARTON: rejection by PHO_STDPAR ',ITRY2 | |
11993 | CALL PHO_PREVNT(-1) | |
11994 | ENDIF | |
11995 | RETURN | |
11996 | ENDIF | |
11997 | IF(MHPOM.GT.0) THEN | |
11998 | IDNODF = 3 | |
11999 | ELSE IF(MSPOM.GT.0) THEN | |
12000 | IDNODF = 2 | |
12001 | ELSE | |
12002 | IDNODF = 1 | |
12003 | ENDIF | |
12004 | C check of quantum numbers of parton configurations | |
12005 | IF(IDEB(3).GE.0) THEN | |
12006 | CALL PHO_CHECK(1,IREJ) | |
12007 | IF(IREJ.NE.0) GOTO 50 | |
12008 | ENDIF | |
12009 | C sample strings to prepare fragmentation | |
12010 | CALL PHO_STRING(1,IREJ) | |
12011 | IF(IREJ.NE.0) THEN | |
12012 | IF(IREJ.EQ.50) RETURN | |
12013 | IFAIL(30) = IFAIL(30)+1 | |
12014 | IF(IDEB(3).GE.2) THEN | |
12015 | WRITE(LO,'(/1X,A,I5)') | |
12016 | & 'PHO_PARTON: rejection by PHO_STRING',ITRY2 | |
12017 | CALL PHO_PREVNT(-1) | |
12018 | ENDIF | |
12019 | IF(ITRY2.LT.20) GOTO 50 | |
12020 | IF(IDEB(3).GE.1) THEN | |
12021 | WRITE(LO,'(/1X,A,I5)') | |
12022 | & 'PHO_PARTON: rejection',ITRY2 | |
12023 | CALL PHO_PREVNT(-1) | |
12024 | ENDIF | |
12025 | RETURN | |
12026 | ENDIF | |
12027 | ||
12028 | C statistics | |
12029 | ISPA = ISPA+KSPOM | |
12030 | IHPA = IHPA+KHPOM | |
12031 | ISRA = ISRA+KSREG | |
12032 | ISTA = ISTA+KSTRG | |
12033 | ISLA = ISLA+KSLOO | |
12034 | ||
12035 | C------------------------------------------------------------------- | |
12036 | C elastic scattering / quasi-elastic rho/omega/phi production | |
12037 | ||
12038 | ELSE IF((IPROC.EQ.2).OR.(IPROC.EQ.3)) THEN | |
12039 | IF(IDEB(3).GE.5) WRITE(LO,'(1X,A,I10,I4)') | |
12040 | & 'PHO_PARTON: ela./q-ela.sca:(EV,IPROC)',KEVENT,IPROC | |
12041 | ||
12042 | C DPMJET call with special projectile / target: transform into CMS | |
12043 | IF((IPAMDL(13).GT.0).AND.(IPOIX3.EQ.0)) | |
12044 | & CALL PHO_DFWRAP(1,JM1,JM2) | |
12045 | ||
12046 | CALL PHO_QELAST(IPROC,JM1,JM2,IREJ) | |
12047 | ||
12048 | IF(IREJ.NE.0) THEN | |
12049 | C DPMJET call with special projectile / target: clean up | |
12050 | IF((IPAMDL(13).GT.0).AND.(IPOIX3.EQ.0)) | |
12051 | & CALL PHO_DFWRAP(-2,JM1,JM2) | |
12052 | IF(IDEB(3).GE.2) THEN | |
12053 | WRITE(LO,'(/1X,A,I5)') | |
12054 | & 'PHO_PARTON: rejection by PHO_QELAST',IREJ | |
12055 | CALL PHO_PREVNT(-1) | |
12056 | ENDIF | |
12057 | RETURN | |
12058 | ENDIF | |
12059 | ||
12060 | C DPMJET call with special projectile / target: transform back | |
12061 | IF((IPAMDL(13).GT.0).AND.(IPOIX3.EQ.0)) | |
12062 | & CALL PHO_DFWRAP(2,JM1,JM2) | |
12063 | ||
12064 | C prepare possible decays | |
12065 | CALL PHO_STRING(1,IREJ) | |
12066 | IF(IREJ.NE.0) THEN | |
12067 | IF(IREJ.EQ.50) RETURN | |
12068 | IFAIL(30) = IFAIL(30)+1 | |
12069 | RETURN | |
12070 | ENDIF | |
12071 | ||
12072 | C--------------------------------------------------------------------- | |
12073 | C double Pomeron scattering | |
12074 | ||
12075 | ELSE IF(IPROC.EQ.4) THEN | |
12076 | MSOFT = 0 | |
12077 | MHARD = 0 | |
12078 | IF(IDEB(3).GE.5) WRITE(LO,'(1X,A,I10)') | |
12079 | & 'PHO_PARTON: EV,double-pomeron scattering',KEVENT | |
12080 | IDPS = IDPS+1 | |
12081 | ITRY2 = 0 | |
12082 | 60 CONTINUE | |
12083 | ITRY2 = ITRY2+1 | |
12084 | IF(ITRY2.GT.1) CALL PHO_EVEINI(2,P1,P2,JM1,JM2) | |
12085 | C | |
12086 | CALL PHO_CDIFF(JM1,JM2,MSOFT,MHARD,1,IREJ) | |
12087 | IF(IREJ.NE.0) THEN | |
12088 | IF(IDEB(3).GE.2) THEN | |
12089 | WRITE(LO,'(/1X,A,I5)') | |
12090 | & 'PHO_PARTON: rejection by PHO_CDIFF',IREJ | |
12091 | CALL PHO_PREVNT(-1) | |
12092 | ENDIF | |
12093 | RETURN | |
12094 | ENDIF | |
12095 | C check of quantum numbers of parton configurations | |
12096 | IF(IDEB(3).GE.0) THEN | |
12097 | CALL PHO_CHECK(1,IREJ) | |
12098 | IF(IREJ.NE.0) GOTO 60 | |
12099 | ENDIF | |
12100 | C sample strings to prepare fragmentation | |
12101 | CALL PHO_STRING(1,IREJ) | |
12102 | IF(IREJ.NE.0) THEN | |
12103 | IF(IREJ.EQ.50) RETURN | |
12104 | IFAIL(30) = IFAIL(30)+1 | |
12105 | IF(IDEB(3).GE.2) THEN | |
12106 | WRITE(LO,'(/1X,A,I5)') | |
12107 | & 'PHO_PARTON: rejection by PHO_STRING',ITRY2 | |
12108 | CALL PHO_PREVNT(-1) | |
12109 | ENDIF | |
12110 | IF(ITRY2.LT.10) GOTO 60 | |
12111 | WRITE(LO,'(/1X,A,I5)') 'PHO_PARTON: rejection',ITRY2 | |
12112 | CALL PHO_PREVNT(-1) | |
12113 | RETURN | |
12114 | ENDIF | |
12115 | IDPA = IDPA+1 | |
12116 | ||
12117 | C----------------------------------------------------------------------- | |
12118 | C single / double diffraction dissociation | |
12119 | ||
12120 | ELSE IF((IPROC.GE.5).AND.(IPROC.LE.7)) THEN | |
12121 | MSOFT = 0 | |
12122 | MHARD = 0 | |
12123 | IF(IDEB(3).GE.5) WRITE(LO,'(1X,A,I10,2I4)') | |
12124 | & 'PHO_PARTON: EV,diffraction',KEVENT,IPAR1,IPAR2 | |
12125 | IF(IPROC.EQ.5) ID1S = ID1S+1 | |
12126 | IF(IPROC.EQ.6) ID2S = ID2S+1 | |
12127 | IF(IPROC.EQ.7) ID3S = ID3S+1 | |
12128 | ITRY2 = 0 | |
12129 | 70 CONTINUE | |
12130 | ITRY2 = ITRY2+1 | |
12131 | IF(ITRY2.GT.1) CALL PHO_EVEINI(2,P1,P2,JM1,JM2) | |
12132 | IPAR1 = 1 | |
12133 | IPAR2 = 1 | |
12134 | IF(IPROC.EQ.5) IPAR2 = 0 | |
12135 | IF(IPROC.EQ.6) IPAR1 = 0 | |
12136 | C calculate rapidity gap survival probability | |
12137 | SPROB = 1.D0 | |
12138 | IF(ECM.GT.10.D0) THEN | |
12139 | IF((IPAR1.GE.1).AND.(IPAR2.EQ.0)) THEN | |
12140 | IF(SIGTR1(1).LT.1.D-10) THEN | |
12141 | SPROB = 1.D0 | |
12142 | ELSE | |
12143 | SPROB = SIGHSD(1)/(SIGTR1(1)-2.D0*(SIGDPO(1)+SIGDPO(2))) | |
12144 | ENDIF | |
12145 | ELSE IF((IPAR1.EQ.0).AND.(IPAR2.GE.1)) THEN | |
12146 | IF(SIGTR2(1).LT.1.D-10) THEN | |
12147 | SPROB = 1.D0 | |
12148 | ELSE | |
12149 | SPROB = SIGHSD(2)/(SIGTR2(1)-2.D0*(SIGDPO(1)+SIGDPO(3))) | |
12150 | ENDIF | |
12151 | ELSE IF((IPAR1.GE.1).AND.(IPAR2.GE.1)) THEN | |
12152 | IF(SIGLOO.LT.1.D-10) THEN | |
12153 | SPROB = 1.D0 | |
12154 | ELSE | |
12155 | SPROB = SIGHDD/SIGLOO | |
12156 | ENDIF | |
12157 | ENDIF | |
12158 | ENDIF | |
12159 | **sr | |
12160 | * temporary patch, r.e. 8.6.99 | |
12161 | SPROB = 1.D0 | |
12162 | ** | |
12163 | ||
12164 | C DPMJET call with special projectile / target: transform into CMS | |
12165 | IF((IPAMDL(13).GT.0).AND.(IPOIX3.EQ.0)) | |
12166 | & CALL PHO_DFWRAP(1,JM1,JM2) | |
12167 | ||
12168 | CALL PHO_DIFDIS(IPAR1,IPAR2,JM1,JM2,SPROB,0,MSOFT,MHARD,IREJ) | |
12169 | ||
12170 | IF(IREJ.NE.0) THEN | |
12171 | C DPMJET call with special projectile / target: clean up | |
12172 | IF((IPAMDL(13).GT.0).AND.(IPOIX3.EQ.0)) | |
12173 | & CALL PHO_DFWRAP(-2,JM1,JM2) | |
12174 | IF(IDEB(3).GE.2) THEN | |
12175 | WRITE(LO,'(/1X,A,I5)') | |
12176 | & 'PHO_PARTON: rejection by PHO_DIFDIS',IREJ | |
12177 | CALL PHO_PREVNT(-1) | |
12178 | ENDIF | |
12179 | RETURN | |
12180 | ENDIF | |
12181 | ||
12182 | C DPMJET call with special projectile / target: transform back | |
12183 | IF((IPAMDL(13).GT.0).AND.(IPOIX3.EQ.0)) | |
12184 | & CALL PHO_DFWRAP(2,JM1,JM2) | |
12185 | ||
12186 | C check of quantum numbers of parton configurations | |
12187 | IF(IDEB(3).GE.0) THEN | |
12188 | CALL PHO_CHECK(1,IREJ) | |
12189 | IF(IREJ.NE.0) GOTO 70 | |
12190 | ENDIF | |
12191 | C sample strings to prepare fragmentation | |
12192 | CALL PHO_STRING(1,IREJ) | |
12193 | IF(IREJ.NE.0) THEN | |
12194 | IF(IREJ.EQ.50) RETURN | |
12195 | IFAIL(30) = IFAIL(30)+1 | |
12196 | IF(IDEB(3).GE.2) THEN | |
12197 | WRITE(LO,'(/1X,A,I5)') | |
12198 | & 'PHO_PARTON: rejection by PHO_STRING',ITRY2 | |
12199 | CALL PHO_PREVNT(-1) | |
12200 | ENDIF | |
12201 | IF(ITRY2.LT.10) GOTO 70 | |
12202 | WRITE(LO,'(/1X,A,I5)') | |
12203 | & 'PHO_PARTON: rejection',ITRY2 | |
12204 | CALL PHO_PREVNT(-1) | |
12205 | RETURN | |
12206 | ENDIF | |
12207 | IF(IPROC.EQ.5) ID1A = ID1A+1 | |
12208 | IF(IPROC.EQ.6) ID2A = ID2A+1 | |
12209 | IF(IPROC.EQ.7) ID3A = ID3A+1 | |
12210 | ||
12211 | C----------------------------------------------------------------------- | |
12212 | C single / double direct processes | |
12213 | ||
12214 | ELSE IF(IPROC.EQ.8) THEN | |
12215 | MSREG = 0 | |
12216 | MSPOM = 0 | |
12217 | MHPOM = 0 | |
12218 | MHDIR = 1 | |
12219 | IF(IDEB(3).GE.5) THEN | |
12220 | WRITE(LO,'(1X,A,I10)') 'PHO_PARTON: EV,direct proc',KEVENT | |
12221 | ENDIF | |
12222 | IDIS = IDIS+MHDIR | |
12223 | ITRY2 = 0 | |
12224 | 80 CONTINUE | |
12225 | ITRY2 = ITRY2+1 | |
12226 | IF(ITRY2.GT.1) CALL PHO_EVEINI(2,P1,P2,JM1,JM2) | |
12227 | KSPOM = MSPOM | |
12228 | KSREG = MSREG | |
12229 | KHPOM = MHPOM | |
12230 | KHDIR = 4 | |
12231 | ||
12232 | CALL PHO_STDPAR(JM1,JM2,1,MSPOM,MSREG,MHPOM,MHDIR,IREJ) | |
12233 | IF(IREJ.NE.0) THEN | |
12234 | IF(IREJ.EQ.50) RETURN | |
12235 | IF(IDEB(3).GE.2) THEN | |
12236 | WRITE(LO,'(/1X,A,I5)') | |
12237 | & 'PHO_PARTON: rejection by PHO_STDPAR',ITRY2 | |
12238 | CALL PHO_PREVNT(-1) | |
12239 | ENDIF | |
12240 | RETURN | |
12241 | ENDIF | |
12242 | IDNODF = 4 | |
12243 | C check of quantum numbers of parton configurations | |
12244 | IF(IDEB(3).GE.0) THEN | |
12245 | CALL PHO_CHECK(1,IREJ) | |
12246 | IF(IREJ.NE.0) GOTO 80 | |
12247 | ENDIF | |
12248 | C sample strings to prepare fragmentation | |
12249 | CALL PHO_STRING(1,IREJ) | |
12250 | IF(IREJ.NE.0) THEN | |
12251 | IF(IREJ.EQ.50) RETURN | |
12252 | IFAIL(30) = IFAIL(30)+1 | |
12253 | IF(IDEB(3).GE.2) THEN | |
12254 | WRITE(LO,'(/1X,A,I5)') | |
12255 | & 'PHO_PARTON: rejection by PHO_STRING',ITRY2 | |
12256 | CALL PHO_PREVNT(-1) | |
12257 | ENDIF | |
12258 | IF(ITRY2.LT.10) GOTO 80 | |
12259 | WRITE(LO,'(/1X,A,I5)') 'PHO_PARTON: rejection',ITRY2 | |
12260 | CALL PHO_PREVNT(-1) | |
12261 | RETURN | |
12262 | ENDIF | |
12263 | IF(IPROC.EQ.5) ID1A = ID1A+1 | |
12264 | IF(IPROC.EQ.6) ID2A = ID2A+1 | |
12265 | IF(IPROC.EQ.7) ID3A = ID3A+1 | |
12266 | IDIA = IDIA+MHDIR | |
12267 | ||
12268 | C----------------------------------------------------------------------- | |
12269 | C initialize control statistics | |
12270 | ||
12271 | ELSE IF(IPROC.EQ.-1) THEN | |
12272 | CALL PHO_SAMPRB(ECM,-1,0,0,0) | |
12273 | CALL PHO_STDPAR(-1,0,0,0,0,0,0,IREJ) | |
12274 | CALL PHO_SEAFLA(-1,0,0,DUM) | |
12275 | IF((IFPAP(1).EQ.22).OR.(IFPAP(2).EQ.22)) | |
12276 | & CALL PHO_QELAST(-1,1,2,0) | |
12277 | ISPS = 0 | |
12278 | ISPA = 0 | |
12279 | ISRS = 0 | |
12280 | ISRA = 0 | |
12281 | IHPS = 0 | |
12282 | IHPA = 0 | |
12283 | ISTS = 0 | |
12284 | ISTA = 0 | |
12285 | ISLS = 0 | |
12286 | ISLA = 0 | |
12287 | ID1S = 0 | |
12288 | ID1A = 0 | |
12289 | ID2S = 0 | |
12290 | ID2A = 0 | |
12291 | ID3S = 0 | |
12292 | ID3A = 0 | |
12293 | IDPS = 0 | |
12294 | IDPA = 0 | |
12295 | IDIS = 0 | |
12296 | IDIA = 0 | |
12297 | CALL PHO_STRING(-1,IREJ) | |
12298 | CALL PHO_DIFDIS(0,0,0,0,0.D0,-1,0,0,IREJ) | |
12299 | RETURN | |
12300 | ||
12301 | C----------------------------------------------------------------------- | |
12302 | C produce statistics summary | |
12303 | ||
12304 | ELSE IF(IPROC.EQ.-2) THEN | |
12305 | IF(ISWMDL(2).NE.0) CALL PHO_SAMPRB(ECM,-2,0,0,0) | |
12306 | IF(IDEB(3).GE.0) THEN | |
12307 | WRITE(LO,'(/1X,A,/1X,A)') | |
12308 | & 'PHO_PARTON: internal statistics on parton configurations', | |
12309 | & '--------------------------------------------------------' | |
12310 | WRITE(LO,'(5X,A)') 'process sampled accepted' | |
12311 | WRITE(LO,'(5X,A,2I12)') 'soft pom.',ISPS,ISPA | |
12312 | WRITE(LO,'(5X,A,2I12)') 'hard pom.',IHPS,IHPA | |
12313 | WRITE(LO,'(5X,A,2I12)') 'soft reg.',ISRS,ISRA | |
12314 | WRITE(LO,'(5X,A,2I12)') 'enh. tri.',ISTS,ISTA | |
12315 | WRITE(LO,'(5X,A,2I12)') 'enh. loo.',ISLS,ISLA | |
12316 | WRITE(LO,'(5X,A,2I12)') 'diff.pa1.',ID1S,ID1A | |
12317 | WRITE(LO,'(5X,A,2I12)') 'diff.pa2.',ID2S,ID2A | |
12318 | WRITE(LO,'(5X,A,2I12)') 'doub.dif.',ID3S,ID3A | |
12319 | WRITE(LO,'(5X,A,2I12)') 'doub.pom.',IDPS,IDPA | |
12320 | WRITE(LO,'(5X,A,2I12/)') 'dir.phot.',IDIS,IDIA | |
12321 | ENDIF | |
12322 | CALL PHO_STDPAR(-2,0,0,0,0,0,0,IREJ) | |
12323 | IF((IFPAP(1).EQ.22).OR.(IFPAP(2).EQ.22)) | |
12324 | & CALL PHO_QELAST(-2,1,2,0) | |
12325 | CALL PHO_STRING(-2,IREJ) | |
12326 | CALL PHO_DIFDIS(0,0,0,0,0.D0,-2,0,0,IREJ) | |
12327 | CALL PHO_SEAFLA(-2,0,0,DUM) | |
12328 | RETURN | |
12329 | ELSE | |
12330 | WRITE(LO,'(1X,A,I2)') | |
12331 | & 'PARTON:ERROR: unknown process ID ',IPROC | |
12332 | STOP | |
12333 | ENDIF | |
12334 | ||
12335 | END | |
12336 | ||
12337 | *$ CREATE PHO_MCINI.FOR | |
12338 | *COPY PHO_MCINI | |
12339 | CDECK ID>, PHO_MCINI | |
12340 | SUBROUTINE PHO_MCINI | |
12341 | C******************************************************************** | |
12342 | C | |
12343 | C initialization of MC event generation | |
12344 | C | |
12345 | C******************************************************************** | |
12346 | IMPLICIT DOUBLE PRECISION (A-H,O-Z) | |
12347 | SAVE | |
12348 | ||
12349 | PARAMETER ( PIMASS = 0.13D0, | |
12350 | & TINY = 1.D-10 ) | |
12351 | ||
12352 | C input/output channels | |
12353 | INTEGER LI,LO | |
12354 | COMMON /POINOU/ LI,LO | |
12355 | C event debugging information | |
12356 | INTEGER NMAXD | |
12357 | PARAMETER (NMAXD=100) | |
12358 | INTEGER IDEB,KSPOM,KHPOM,KSREG,KHDIR,KACCEP,KSTRG,KHTRG,KSLOO, | |
12359 | & KHLOO,KSDPO,KHDPO,KEVENT,KSOFT,KHARD | |
12360 | COMMON /PODEBG/ IDEB(NMAXD),KSPOM,KHPOM,KSREG,KHDIR,KACCEP,KSTRG, | |
12361 | & KHTRG,KSLOO,KHLOO,KSDPO,KHDPO,KEVENT,KSOFT,KHARD | |
12362 | C model switches and parameters | |
12363 | CHARACTER*8 MDLNA | |
12364 | INTEGER ISWMDL,IPAMDL | |
12365 | DOUBLE PRECISION PARMDL | |
12366 | COMMON /POMDLS/ MDLNA(50),ISWMDL(50),PARMDL(400),IPAMDL(400) | |
12367 | C general process information | |
12368 | INTEGER IPROCE,IDNODF,IDIFR1,IDIFR2,IDDPOM,IPRON | |
12369 | COMMON /POPRCS/ IPROCE,IDNODF,IDIFR1,IDIFR2,IDDPOM,IPRON(15,4) | |
12370 | C cross sections | |
12371 | INTEGER IPFIL,IFAFIL,IFBFIL | |
12372 | DOUBLE PRECISION SIGTOT,SIGELA,SIGVM,SIGINE,SIGNDF,SIGDIR, | |
12373 | & SIGLSD,SIGHSD,SIGLDD,SIGHDD,SIGCDF, | |
12374 | & SIGPOM,SIGREG,SIGHAR,SIGTR1,SIGTR2,SIGLOO, | |
12375 | & SIGDPO,SIG1SO,SIG1HA,SLOEL,SLOVM,SIGCOR, | |
12376 | & FSUP,FSUD,FSUH,ECMFIL,P2AFIL,P2BFIL | |
12377 | COMMON /POCSEC/ SIGTOT,SIGELA,SIGVM(0:4,0:4),SIGINE,SIGNDF,SIGDIR, | |
12378 | & SIGLSD(2),SIGHSD(2),SIGLDD,SIGHDD,SIGCDF(0:4), | |
12379 | & SIGPOM,SIGREG,SIGHAR,SIGTR1(2),SIGTR2(2),SIGLOO, | |
12380 | & SIGDPO(4),SIG1SO,SIG1HA,SLOEL,SLOVM(4,4),SIGCOR, | |
12381 | & FSUP(2),FSUD(2),FSUH(2),ECMFIL,P2AFIL,P2BFIL, | |
12382 | & IPFIL,IFAFIL,IFBFIL | |
12383 | C hard cross sections and MC selection weights | |
12384 | INTEGER Max_pro_2 | |
12385 | PARAMETER ( Max_pro_2 = 16 ) | |
12386 | INTEGER IHa_last,IHb_last,MH_pro_on,MH_tried, | |
12387 | & MH_acc_1,MH_acc_2 | |
12388 | DOUBLE PRECISION Hfac,HWgx,HSig,Hdpt,HEcm_last,HQ2a_last,HQ2b_last | |
12389 | COMMON /POHRCS/ Hfac(-1:Max_pro_2),HWgx(-1:Max_pro_2), | |
12390 | & HSig(-1:Max_pro_2),Hdpt(-1:Max_pro_2), | |
12391 | & HEcm_last,HQ2a_last,HQ2b_last,IHa_last,IHb_last, | |
12392 | & MH_pro_on(-1:Max_pro_2,0:4),MH_tried(-1:Max_pro_2,0:4), | |
12393 | & MH_acc_1(-1:Max_pro_2,0:4),MH_acc_2(-1:Max_pro_2,0:4) | |
12394 | C interpolation tables for hard cross section and MC selection weights | |
12395 | INTEGER Max_tab_E,Max_tab_Q2,Max_pro_tab | |
12396 | PARAMETER ( Max_tab_E = 20, Max_tab_Q2 = 10, Max_pro_tab = 16 ) | |
12397 | INTEGER IH_Q2a_up,IH_Q2b_up,IH_Ecm_up | |
12398 | DOUBLE PRECISION Hfac_tab,HWgx_tab,HSig_tab,Hdpt_tab, | |
12399 | & HQ2a_tab,HQ2b_tab,HEcm_tab | |
12400 | COMMON /POHTAB/ | |
12401 | & Hfac_tab(-1:Max_pro_tab,Max_tab_E,Max_tab_Q2,Max_tab_Q2,0:4), | |
12402 | & HWgx_tab(-1:Max_pro_tab,Max_tab_E,Max_tab_Q2,Max_tab_Q2,0:4), | |
12403 | & HSig_tab(-1:Max_pro_tab,Max_tab_E,Max_tab_Q2,Max_tab_Q2,0:4), | |
12404 | & Hdpt_tab(-1:Max_pro_tab,Max_tab_E,Max_tab_Q2,Max_tab_Q2,0:4), | |
12405 | & HQ2a_tab(1:Max_tab_Q2,0:4),HQ2b_tab(1:Max_tab_Q2,0:4), | |
12406 | & HEcm_tab(1:Max_tab_E,0:4), | |
12407 | & IH_Q2a_up(0:4),IH_Q2b_up(0:4),IH_Ecm_up(0:4) | |
12408 | C global event kinematics and particle IDs | |
12409 | INTEGER IFPAP,IFPAB | |
12410 | DOUBLE PRECISION ECM,PCM,PMASS,PVIRT | |
12411 | COMMON /POGCMS/ ECM,PCM,PMASS(2),PVIRT(2),IFPAP(2),IFPAB(2) | |
12412 | C obsolete cut-off information | |
12413 | DOUBLE PRECISION PTCUT,PTANO,FPS,FPH,PSOMIN,XSOMIN | |
12414 | COMMON /POCUT1/ PTCUT(4),PTANO(4),FPS(4),FPH(4),PSOMIN,XSOMIN | |
12415 | C event weights and generated cross section | |
12416 | INTEGER IPOWGC,ISWCUT,IVWGHT | |
12417 | DOUBLE PRECISION SIGGEN,HSWGHT,HSWCUT,EVWGHT | |
12418 | COMMON /POWGHT/ SIGGEN(4),HSWGHT(0:10),HSWCUT(20),EVWGHT(0:10), | |
12419 | & IPOWGC(0:10),ISWCUT(20),IVWGHT(0:10) | |
12420 | C cut probability distribution | |
12421 | INTEGER IEETA1,IIMAX,KKMAX | |
12422 | PARAMETER( IEETA1=20, IIMAX=20, KKMAX=20 ) | |
12423 | INTEGER IEEMAX,IMAX,KMAX | |
12424 | REAL PROB | |
12425 | DOUBLE PRECISION EPTAB | |
12426 | COMMON /POPROB/ PROB(4,IEETA1,0:IIMAX,0:KKMAX),EPTAB(4,IEETA1), | |
12427 | & IEEMAX,IMAX,KMAX | |
12428 | C energy-interpolation table | |
12429 | INTEGER IEETA2 | |
12430 | PARAMETER ( IEETA2 = 20 ) | |
12431 | INTEGER ISIMAX | |
12432 | DOUBLE PRECISION SIGTAB,SIGECM | |
12433 | COMMON /POTABL/ SIGTAB(4,80,IEETA2),SIGECM(4,IEETA2),ISIMAX | |
12434 | ||
12435 | CHARACTER*15 PHO_PNAME | |
12436 | DIMENSION ECMF(4) | |
12437 | ||
12438 | DATA XMPOM / 0.766D0 / | |
12439 | ||
12440 | C initialize fragmentation | |
12441 | CALL PHO_FRAINI(ISWMDL(6)) | |
12442 | ||
12443 | C reset interpolation tables | |
12444 | DO 50 I=1,4 | |
12445 | DO 60 J=1,10 | |
12446 | DO 70 K=1,70 | |
12447 | SIGTAB(I,K,J) = 0.D0 | |
12448 | 70 CONTINUE | |
12449 | SIGECM(I,J) = 0.D0 | |
12450 | 60 CONTINUE | |
12451 | 50 CONTINUE | |
12452 | ||
12453 | C max. number of allowed colors (large N expansion) | |
12454 | IC1 = 0 | |
12455 | IC2 = 10000 | |
12456 | CALL PHO_SELCOL(IC1,IC2,0,0,0,0,-1) | |
12457 | ||
12458 | C lower energy limit of initialization | |
12459 | ETABLO = PARMDL(19) | |
12460 | IF(ECM.LE.5.D0) ETABLO = MIN(2.5D0,ETABLO) | |
12461 | ||
12462 | WRITE(LO,'(/,1X,A,2F12.1)') | |
12463 | & 'PHO_MCINI: selected energy range (SQRT(S))',ETABLO,ECM | |
12464 | WRITE(LO,'(5X,A,A,F7.3,E15.4)') | |
12465 | & 'particle 1 (name,mass,virtuality): ',PHO_PNAME(IFPAP(1),1), | |
12466 | & PMASS(1),PVIRT(1) | |
12467 | WRITE(LO,'(5X,A,A,F7.3,E15.4)') | |
12468 | & 'particle 2 (name,mass,virtuality): ',PHO_PNAME(IFPAP(2),1), | |
12469 | & PMASS(2),PVIRT(2) | |
12470 | ||
12471 | C cuts on probabilities of multiple interactions | |
12472 | IMAX = MIN(IPAMDL(32),IIMAX) | |
12473 | KMAX = MIN(IPAMDL(33),KKMAX) | |
12474 | AH = 2.D0*PTCUT(1)/ECM | |
12475 | IMAX = MAX(5,MIN(IMAX,INT(ECM/2.0D0))) | |
12476 | KMAX = MIN(KMAX,1+INT(0.9*1.D0/AH)) | |
12477 | ||
12478 | C hard interpolation table | |
12479 | ECMF(1) = ECM | |
12480 | ECMF(2) = 0.9D0*ECMF(1) | |
12481 | ECMF(3) = ECMF(2) | |
12482 | ECMF(4) = ECMF(2) | |
12483 | do k=1,4 | |
12484 | IH_Ecm_up(k) = MIN(IPAMDL(30),Max_tab_E) | |
12485 | IF(ECMF(k).LT.100.D0) IH_Ecm_up(k) = MIN(IH_Ecm_up(k),15) | |
12486 | IF(ECMF(k).LT.50.D0) IH_Ecm_up(k) = MIN(IH_Ecm_up(k),10) | |
12487 | IF(ECMF(k).LT.10.D0) IH_Ecm_up(k) = MIN(IH_Ecm_up(k),5) | |
12488 | enddo | |
12489 | ||
12490 | C initialization of hard scattering for all channels and cutoffs | |
12491 | IF(HSWCUT(5).GT.PARMDL(36)) CALL PHO_HARMCI(-1,ECMF(1)) | |
12492 | I0 = 4 | |
12493 | IF(ISWMDL(2).EQ.0) I0 = 1 | |
12494 | DO 110 I=I0,1,-1 | |
12495 | CALL PHO_HARMCI(I,ECMF(I)) | |
12496 | 110 CONTINUE | |
12497 | ||
12498 | C dimension of interpolation table of cut probabilities | |
12499 | IEEMAX = MIN(IPAMDL(31),IEETA1) | |
12500 | IF(ECM.LT.100.D0) IEEMAX = MIN(IEEMAX,15) | |
12501 | IF(ECM.LT.50.D0) IEEMAX = MIN(IEEMAX,10) | |
12502 | IF(ECM.LT.10.D0) IEEMAX = MIN(IEEMAX,5) | |
12503 | ISIMAX = IEEMAX | |
12504 | ||
12505 | C calculate probability distribution | |
12506 | I0 = 4 | |
12507 | IFT1 = IFPAP(1) | |
12508 | IFT2 = IFPAP(2) | |
12509 | XMT1 = PMASS(1) | |
12510 | XMT2 = PMASS(2) | |
12511 | XVT1 = PVIRT(1) | |
12512 | XVT2 = PVIRT(2) | |
12513 | IF(ISWMDL(2).EQ.0) I0 = 1 | |
12514 | DO 150 IP=I0,1,-1 | |
12515 | ECMPRO = ECMF(IP)*1.001D0 | |
12516 | IF(IP.EQ.4) THEN | |
12517 | IFPAP(1) = 990 | |
12518 | IFPAP(2) = 990 | |
12519 | PMASS(1) = XMPOM | |
12520 | PMASS(2) = XMPOM | |
12521 | PVIRT(1) = 0.D0 | |
12522 | PVIRT(2) = 0.D0 | |
12523 | ELSE IF(IP.EQ.3) THEN | |
12524 | IFPAP(1) = IFT2 | |
12525 | IFPAP(2) = 990 | |
12526 | PMASS(1) = XMT2 | |
12527 | PMASS(2) = XMPOM | |
12528 | PVIRT(1) = XVT2 | |
12529 | PVIRT(2) = 0.D0 | |
12530 | ELSE IF(IP.EQ.2) THEN | |
12531 | IFPAP(1) = IFT1 | |
12532 | IFPAP(2) = 990 | |
12533 | PMASS(1) = XMT1 | |
12534 | PMASS(2) = XMPOM | |
12535 | PVIRT(1) = XVT1 | |
12536 | PVIRT(2) = 0.D0 | |
12537 | ELSE | |
12538 | IFPAP(1) = IFT1 | |
12539 | IFPAP(2) = IFT2 | |
12540 | PMASS(1) = XMT1 | |
12541 | PMASS(2) = XMT2 | |
12542 | PVIRT(1) = XVT1 | |
12543 | PVIRT(2) = XVT2 | |
12544 | ENDIF | |
12545 | IF(IEEMAX.GT.1) THEN | |
12546 | IF(IP.EQ.1) THEN | |
12547 | ELMIN = LOG(ETABLO) | |
12548 | ELSE | |
12549 | ELMIN = LOG(2.5D0) | |
12550 | ENDIF | |
12551 | EDELTA = (LOG(ECMPRO)-ELMIN)/DBLE(MAX(1,IEEMAX-1)) | |
12552 | DO 100 I=1,IEEMAX | |
12553 | ECMPRO = EXP(ELMIN+DBLE(I-1)*EDELTA) | |
12554 | CALL PHO_PRBDIS(IP,ECMPRO,I) | |
12555 | 100 CONTINUE | |
12556 | ELSE | |
12557 | CALL PHO_PRBDIS(IP,ECMPRO,1) | |
12558 | ENDIF | |
12559 | ||
12560 | C debug output of cross section tables | |
12561 | IF(((IDEB(62).GE.0).AND.(IP.EQ.1)).OR.(IDEB(62).GE.3)) THEN | |
12562 | IF((PVIRT(1)+PVIRT(2).GT.0.01D0).AND.(IDEB(62).EQ.0)) GOTO 201 | |
12563 | WRITE(LO,'(/1X,A,I3/1X,A,/1X,A)') | |
12564 | &'Table of total cross sections (mb) for particle combination',IP, | |
12565 | &' Ecm SIGtot SIGela SIGine SIGqel SIGsd1 SIGsd2 SIGdd', | |
12566 | &'-------------------------------------------------------------' | |
12567 | DO 200 I=1,IEEMAX | |
12568 | WRITE(LO,'(1X,1P,8E9.2)') SIGECM(IP,I),SIGTAB(IP,1,I), | |
12569 | & SIGTAB(IP,2,I),SIGTAB(IP,28,I),SIGTAB(IP,3,I), | |
12570 | & SIGTAB(IP,30,I)+SIGTAB(IP,32,I), | |
12571 | & SIGTAB(IP,31,I)+SIGTAB(IP,33,I), | |
12572 | & SIGTAB(IP,34,I)+SIGTAB(IP,35,I) | |
12573 | 200 CONTINUE | |
12574 | 201 CONTINUE | |
12575 | IF(IDEB(62).GE.2) THEN | |
12576 | WRITE(LO,'(/1X,A,I3/1X,A,/1X,A)') | |
12577 | &'Table of partial x-sections (mb) for particle combination',IP, | |
12578 | &' Ecm SIGSD1L SIGSD1H SIGSD2L SIGSD2H SIGDDL SIGDDH SIGCDF', | |
12579 | &'--------------------------------------------------------------' | |
12580 | DO 205 I=1,IEEMAX | |
12581 | WRITE(LO,'(1X,1P,8E9.2)') SIGECM(IP,I),SIGTAB(IP,30,I), | |
12582 | & SIGTAB(IP,32,I),SIGTAB(IP,31,I),SIGTAB(IP,33,I), | |
12583 | & SIGTAB(IP,34,I),SIGTAB(IP,35,I),SIGTAB(IP,36,I) | |
12584 | 205 CONTINUE | |
12585 | ENDIF | |
12586 | IF(IDEB(62).GE.2) THEN | |
12587 | WRITE(LO,'(/1X,A,I3/1X,A,/1X,A)') | |
12588 | &'Table of born graph x-sections (mb) for particle combination',IP, | |
12589 | &' Ecm SIGSVDM SIGHRES SIGHDIR SIGTR1 SIGTR2 SIGLOO SIGDPO', | |
12590 | &'-------------------------------------------------------------' | |
12591 | DO 210 I=1,IEEMAX | |
12592 | WRITE(LO,'(1X,1P,8E9.2)') SIGECM(IP,I), | |
12593 | & SIGTAB(IP,56,I)+SIGTAB(IP,57,I),SIGTAB(IP,58,I), | |
12594 | & SIGTAB(IP,59,I),SIGTAB(IP,60,I)+SIGTAB(IP,61,I), | |
12595 | & SIGTAB(IP,62,I)+SIGTAB(IP,63,I),SIGTAB(IP,64,I), | |
12596 | & SIGTAB(IP,65,I)+SIGTAB(IP,66,I)+SIGTAB(IP,67,I) | |
12597 | & +SIGTAB(IP,68,I) | |
12598 | 210 CONTINUE | |
12599 | WRITE(LO,'(/1X,A,I3/1X,A,/1X,A)') | |
12600 | &'Table of unitarized x-sections (mb) for particle combination',IP, | |
12601 | &' Ecm SIGSVDM SIGHVDM SIGTR1 SIGTR2 SIGLOO SIGDPO SLOPE', | |
12602 | &'-------------------------------------------------------------' | |
12603 | DO 215 I=1,IEEMAX | |
12604 | WRITE(LO,'(1X,1P,8E9.2)') SIGECM(IP,I),SIGTAB(IP,79,I), | |
12605 | & SIGTAB(IP,80,I),SIGTAB(IP,32,I),SIGTAB(IP,33,I), | |
12606 | & SIGTAB(IP,35,I),SIGTAB(IP,36,I),SIGTAB(IP,39,I) | |
12607 | 215 CONTINUE | |
12608 | ENDIF | |
12609 | IF(IDEB(62).GE.1) THEN | |
12610 | WRITE(LO,'(/1X,A,/1X,A,2I4,/1X,A,/1X,A)') | |
12611 | &'Table of expected average number of cuts in non-diff events:', | |
12612 | &' for max. number of cuts soft/hard:',IMAX,KMAX, | |
12613 | &' Ecm PTCUT SIGNDF POM-S POM-H REG-S', | |
12614 | &'---------------------------------------------' | |
12615 | DO 220 I=1,IEEMAX | |
12616 | WRITE(LO,'(1X,1P,6E10.3)') SIGECM(IP,I),SIGTAB(IP,77,I), | |
12617 | & SIGTAB(IP,78,I),SIGTAB(IP,74,I),SIGTAB(IP,75,I), | |
12618 | & SIGTAB(IP,76,I) | |
12619 | 220 CONTINUE | |
12620 | IF(IP.EQ.1) THEN | |
12621 | WRITE(LO,'(/1X,A,/1X,A,/1X,A)') | |
12622 | & 'Table of rapidity gap survival probability (high-mass diff.):', | |
12623 | & ' Ecm Spro-sd1 Spro-sd2 Spro-dd Spro-cd', | |
12624 | & '---------------------------------------------------' | |
12625 | DO 230 I=1,IEEMAX | |
12626 | IF(SIGECM(IP,I).GT.10.D0) THEN | |
12627 | SPRSD1 = SIGTAB(IP,32,I)/(SIGTAB(IP,60,I) | |
12628 | & -2.D0*(SIGTAB(IP,65,I)+SIGTAB(IP,66,I))) | |
12629 | SPRSD2 = SIGTAB(IP,33,I)/(SIGTAB(IP,62,I) | |
12630 | & -2.D0*(SIGTAB(IP,65,I)+SIGTAB(IP,67,I))) | |
12631 | SPRDD = SIGTAB(IP,35,I)/(SIGTAB(IP,64,I)+SIGTAB(IP,61,I) | |
12632 | & +SIGTAB(IP,63,I)-2.D0*(SIGTAB(IP,66,I) | |
12633 | & +SIGTAB(IP,67,I)+2.D0*SIGTAB(IP,68,I))) | |
12634 | SPRCDF = SIGTAB(IP,36,I)/(SIGTAB(IP,65,I)+SIGTAB(IP,66,I) | |
12635 | & +SIGTAB(IP,67,I)+SIGTAB(IP,68,I)) | |
12636 | WRITE(LO,'(1X,1P,5E10.3)') SIGECM(IP,I), | |
12637 | & SPRSD1,SPRSD2,SPRDD,SPRCDF | |
12638 | ENDIF | |
12639 | 230 CONTINUE | |
12640 | ENDIF | |
12641 | ENDIF | |
12642 | ENDIF | |
12643 | 150 CONTINUE | |
12644 | ||
12645 | C simulate only hard scatterings | |
12646 | IF(ISWMDL(2).EQ.0) THEN | |
12647 | WRITE(LO,'(2(/1X,A))') | |
12648 | & 'WARNING: generation of hard scatterings only!', | |
12649 | & '=============================================' | |
12650 | DO 151 I=2,7 | |
12651 | IPRON(I,1) = 0 | |
12652 | 151 CONTINUE | |
12653 | DO 152 K=2,4 | |
12654 | DO 153 I=1,15 | |
12655 | IPRON(I,K) = 0 | |
12656 | 153 CONTINUE | |
12657 | 152 CONTINUE | |
12658 | SIGGEN(4) = 0.D0 | |
12659 | DO 160 I=1,IEEMAX | |
12660 | SIGMAX = 0.D0 | |
12661 | IF(IPRON(1,1).EQ.1) SIGMAX = SIGTAB(1,58,I) | |
12662 | IF(IPRON(8,1).EQ.1) SIGMAX = SIGMAX+SIGTAB(1,59,I) | |
12663 | IF(SIGMAX.GT.SIGGEN(4)) THEN | |
12664 | ISIGM = I | |
12665 | SIGGEN(4) = SIGMAX | |
12666 | ENDIF | |
12667 | 160 CONTINUE | |
12668 | ELSE | |
12669 | WRITE(LO,'(2(/1X,A))') | |
12670 | & 'activated processes, cross section', | |
12671 | & '----------------------------------' | |
12672 | WRITE(LO,'(5X,A,I3,2X,3I3)') | |
12673 | & ' nondiffr. resolved processes',(IPRON(1,K),K=1,4) | |
12674 | WRITE(LO,'(5X,A,I3,2X,3I3)') | |
12675 | & ' elastic scattering',(IPRON(2,K),K=1,4) | |
12676 | WRITE(LO,'(5X,A,I3,2X,3I3)') | |
12677 | & 'qelast. vectormeson production',(IPRON(3,K),K=1,4) | |
12678 | WRITE(LO,'(5X,A,I3,2X,3I3)') | |
12679 | & ' double pomeron processes',(IPRON(4,K),K=1,4) | |
12680 | WRITE(LO,'(5X,A,I3,2X,3I3)') | |
12681 | & ' single diffract. particle (1)',(IPRON(5,K),K=1,4) | |
12682 | WRITE(LO,'(5X,A,I3,2X,3I3)') | |
12683 | & ' single diffract. particle (2)',(IPRON(6,K),K=1,4) | |
12684 | WRITE(LO,'(5X,A,I3,2X,3I3)') | |
12685 | & ' double diffract. processes',(IPRON(7,K),K=1,4) | |
12686 | WRITE(LO,'(5X,A,I3,2X,3I3)') | |
12687 | & ' direct photon processes',(IPRON(8,K),K=1,4) | |
12688 | ||
12689 | C calculate effective cross section | |
12690 | SIGGEN(4) = 0.D0 | |
12691 | DO 165 I=1,IEEMAX | |
12692 | CALL PHO_CSINT(1,IFPAP(1),IFPAP(2),-1,-1,SIGECM(1,I), | |
12693 | & PVIRT(1),PVIRT(2)) | |
12694 | SIGMAX = 0.D0 | |
12695 | if(iswmdl(2).ge.1) then | |
12696 | IF(IPRON(1,1).EQ.1) SIGMAX = SIGTOT-SIGELA-SIGVM(0,0) | |
12697 | & -SIGCDF(0)-SIGLSD(1)-SIGHSD(1)-SIGLSD(2)-SIGHSD(2) | |
12698 | & -SIGLDD-SIGHDD-SIGDIR | |
12699 | IF(IPRON(2,1).EQ.1) SIGMAX = SIGMAX+SIGELA | |
12700 | IF(IPRON(3,1).EQ.1) SIGMAX = SIGMAX+SIGVM(0,0) | |
12701 | IF(IPRON(4,1).EQ.1) SIGMAX = SIGMAX+SIGCDF(0) | |
12702 | IF(IPRON(5,1).EQ.1) SIGMAX = SIGMAX+SIGLSD(1)+SIGHSD(1) | |
12703 | IF(IPRON(6,1).EQ.1) SIGMAX = SIGMAX+SIGLSD(2)+SIGHSD(2) | |
12704 | IF(IPRON(7,1).EQ.1) SIGMAX = SIGMAX+SIGLDD+SIGHDD | |
12705 | IF(IPRON(8,1).EQ.1) SIGMAX = SIGMAX+SIGDIR | |
12706 | else | |
12707 | IF(IPRON(1,1).EQ.1) SIGMAX = SIGHAR | |
12708 | IF(IPRON(8,1).EQ.1) SIGMAX = SIGMAX+SIGDIR | |
12709 | endif | |
12710 | IF(SIGMAX.GT.SIGGEN(4)) THEN | |
12711 | ISIGM = I | |
12712 | SIGGEN(4) = SIGMAX | |
12713 | ENDIF | |
12714 | 165 CONTINUE | |
12715 | ENDIF | |
12716 | ||
12717 | C debug output | |
12718 | IF(SIGGEN(4).LT.1.D-20) THEN | |
12719 | WRITE(LO,'(//1X,A)') | |
12720 | & 'PHO_MCINI:ERROR: selected processes have vanishing x-section' | |
12721 | STOP | |
12722 | ENDIF | |
12723 | WRITE(LO,'(3X,A,1P3E11.4)') 'maximum search (Elow/Eup/Epeak)', | |
12724 | & SIGECM(1,1),SIGECM(1,IEEMAX),SIGECM(1,ISIGM) | |
12725 | WRITE(LO,'(11X,A,1PE12.4,/)') 'max. cross section (mb)',SIGGEN(4) | |
12726 | ||
12727 | END | |
12728 | ||
12729 | *$ CREATE PHO_REJSTA.FOR | |
12730 | *COPY PHO_REJSTA | |
12731 | CDECK ID>, PHO_REJSTA | |
12732 | SUBROUTINE PHO_REJSTA(IMODE) | |
12733 | C******************************************************************** | |
12734 | C | |
12735 | C MC rejection counting | |
12736 | C | |
12737 | C input IMODE -1 initialization | |
12738 | C -2 output of statistics | |
12739 | C | |
12740 | C******************************************************************** | |
12741 | IMPLICIT NONE | |
12742 | SAVE | |
12743 | ||
12744 | C input/output channels | |
12745 | INTEGER LI,LO | |
12746 | COMMON /POINOU/ LI,LO | |
12747 | C event debugging information | |
12748 | INTEGER NMAXD | |
12749 | PARAMETER (NMAXD=100) | |
12750 | INTEGER IDEB,KSPOM,KHPOM,KSREG,KHDIR,KACCEP,KSTRG,KHTRG,KSLOO, | |
12751 | & KHLOO,KSDPO,KHDPO,KEVENT,KSOFT,KHARD | |
12752 | COMMON /PODEBG/ IDEB(NMAXD),KSPOM,KHPOM,KSREG,KHDIR,KACCEP,KSTRG, | |
12753 | & KHTRG,KSLOO,KHLOO,KSDPO,KHDPO,KEVENT,KSOFT,KHARD | |
12754 | C internal rejection counters | |
12755 | INTEGER NMXJ | |
12756 | PARAMETER (NMXJ=60) | |
12757 | CHARACTER*10 REJTIT | |
12758 | INTEGER IFAIL | |
12759 | COMMON /POLOOP/ IFAIL(NMXJ),REJTIT(NMXJ) | |
12760 | ||
12761 | INTEGER IMODE | |
12762 | ||
12763 | INTEGER I | |
12764 | ||
12765 | C initialization | |
12766 | IF(IMODE.EQ.-1) THEN | |
12767 | DO 100 I=1,NMXJ | |
12768 | IFAIL(I) = 0 | |
12769 | 100 CONTINUE | |
12770 | C | |
12771 | REJTIT(1) = 'PARTON ALL' | |
12772 | REJTIT(2) = 'STDPAR ALL' | |
12773 | REJTIT(3) = 'STDPAR DPO' | |
12774 | REJTIT(4) = 'POMSCA ALL' | |
12775 | REJTIT(5) = 'POMSCA INT' | |
12776 | REJTIT(6) = 'POMSCA KIN' | |
12777 | REJTIT(7) = 'DIFDIS ALL' | |
12778 | REJTIT(8) = 'POSPOM ALL' | |
12779 | REJTIT(9) = 'HRES.DIF.1' | |
12780 | REJTIT(10) = 'HDIR.DIF.1' | |
12781 | REJTIT(11) = 'HRES.DIF.2' | |
12782 | REJTIT(12) = 'HDIR.DIF.2' | |
12783 | REJTIT(13) = 'DIFDIS INT' | |
12784 | REJTIT(14) = 'HADRON SP2' | |
12785 | REJTIT(15) = 'HADRON SP3' | |
12786 | REJTIT(16) = 'HARDIR ALL' | |
12787 | REJTIT(17) = 'HARDIR INT' | |
12788 | REJTIT(18) = 'HARDIR KIN' | |
12789 | REJTIT(19) = 'MCHECK BAR' | |
12790 | REJTIT(20) = 'MCHECK MES' | |
12791 | REJTIT(21) = 'DIF.DISS.1' | |
12792 | REJTIT(22) = 'DIF.DISS.2' | |
12793 | REJTIT(23) = 'STRFRA ALL' | |
12794 | REJTIT(24) = 'MSHELL CHA' | |
12795 | REJTIT(25) = 'PARTPT SOF' | |
12796 | REJTIT(26) = 'PARTPT HAR' | |
12797 | REJTIT(27) = 'INTRINS KT' | |
12798 | REJTIT(28) = 'HACHEK DIR' | |
12799 | REJTIT(29) = 'HACHEK RES' | |
12800 | REJTIT(30) = 'STRING ALL' | |
12801 | REJTIT(31) = 'POMSCA INT' | |
12802 | REJTIT(32) = 'DIFF SLOPE' | |
12803 | REJTIT(33) = 'GLU2QU ALL' | |
12804 | REJTIT(34) = 'MASCOR ALL' | |
12805 | REJTIT(35) = 'PARCOR ALL' | |
12806 | REJTIT(36) = 'MSHELL PAR' | |
12807 | REJTIT(37) = 'MSHELL ALL' | |
12808 | REJTIT(38) = 'POMCOR ALL' | |
12809 | REJTIT(39) = 'DB-POM KIN' | |
12810 | REJTIT(40) = 'DB-POM ALL' | |
12811 | REJTIT(41) = 'SOFTXX ALL' | |
12812 | REJTIT(42) = 'SOFTXX PSP' | |
12813 | ||
12814 | C write output | |
12815 | ELSE IF(IMODE.EQ.-2) THEN | |
12816 | WRITE(LO,'(/,1X,A,/,1X,A)') 'PHO_REJSTA: rejection statistics', | |
12817 | & '--------------------------------' | |
12818 | DO 300 I=1,NMXJ | |
12819 | IF(IFAIL(I).GT.0) | |
12820 | & WRITE(LO,'(1X,I3,1X,A,5X,I15)') I,REJTIT(I),IFAIL(I) | |
12821 | 300 CONTINUE | |
12822 | ELSE | |
12823 | WRITE(LO,'(1X,A,I3)') 'PHO_REJSTA: invalid mode ',IMODE | |
12824 | ENDIF | |
12825 | ||
12826 | END | |
12827 | ||
12828 | *$ CREATE PHO_POSPOM.FOR | |
12829 | *COPY PHO_POSPOM | |
12830 | CDECK ID>, PHO_POSPOM | |
12831 | SUBROUTINE PHO_POSPOM(IP,IND1,IND2,IGEN,IPOM,KCUT,ISWAP,IREJ) | |
12832 | C*********************************************************************** | |
12833 | C | |
12834 | C registration of one cut pomeron (soft/semihard) | |
12835 | C | |
12836 | C input: IP particle combination the pomeron belongs to | |
12837 | C IND1,2 position of X values in /POSOFT/ | |
12838 | C 1 corresponds to a valence-pomeron | |
12839 | C IGEN production process of mother particles | |
12840 | C IPOM pomeron number | |
12841 | C KCUT total number of cut pomerons and reggeons | |
12842 | C | |
12843 | C output: ISWAP exchange of x values | |
12844 | C IND1,2 increased by the number of partons belonging | |
12845 | C to the generated pomeron cut | |
12846 | C IREJ success/failure | |
12847 | C | |
12848 | C********************************************************************** | |
12849 | IMPLICIT DOUBLE PRECISION (A-H,O-Z) | |
12850 | SAVE | |
12851 | ||
12852 | PARAMETER ( DEPS = 1.D-8 ) | |
12853 | ||
12854 | C input/output channels | |
12855 | INTEGER LI,LO | |
12856 | COMMON /POINOU/ LI,LO | |
12857 | C event debugging information | |
12858 | INTEGER NMAXD | |
12859 | PARAMETER (NMAXD=100) | |
12860 | INTEGER IDEB,KSPOM,KHPOM,KSREG,KHDIR,KACCEP,KSTRG,KHTRG,KSLOO, | |
12861 | & KHLOO,KSDPO,KHDPO,KEVENT,KSOFT,KHARD | |
12862 | COMMON /PODEBG/ IDEB(NMAXD),KSPOM,KHPOM,KSREG,KHDIR,KACCEP,KSTRG, | |
12863 | & KHTRG,KSLOO,KHLOO,KSDPO,KHDPO,KEVENT,KSOFT,KHARD | |
12864 | C internal rejection counters | |
12865 | INTEGER NMXJ | |
12866 | PARAMETER (NMXJ=60) | |
12867 | CHARACTER*10 REJTIT | |
12868 | INTEGER IFAIL | |
12869 | COMMON /POLOOP/ IFAIL(NMXJ),REJTIT(NMXJ) | |
12870 | C model switches and parameters | |
12871 | CHARACTER*8 MDLNA | |
12872 | INTEGER ISWMDL,IPAMDL | |
12873 | DOUBLE PRECISION PARMDL | |
12874 | COMMON /POMDLS/ MDLNA(50),ISWMDL(50),PARMDL(400),IPAMDL(400) | |
12875 | C general process information | |
12876 | INTEGER IPROCE,IDNODF,IDIFR1,IDIFR2,IDDPOM,IPRON | |
12877 | COMMON /POPRCS/ IPROCE,IDNODF,IDIFR1,IDIFR2,IDDPOM,IPRON(15,4) | |
12878 | C global event kinematics and particle IDs | |
12879 | INTEGER IFPAP,IFPAB | |
12880 | DOUBLE PRECISION ECM,PCM,PMASS,PVIRT | |
12881 | COMMON /POGCMS/ ECM,PCM,PMASS(2),PVIRT(2),IFPAP(2),IFPAB(2) | |
12882 | C data of c.m. system of Pomeron / Reggeon exchange | |
12883 | INTEGER NPOSP,IDPDG1,IDBAM1,IDPDG2,IDBAM2 | |
12884 | DOUBLE PRECISION ECMP,PCMP,PMASSP,PVIRTP,GAMBEP, | |
12885 | & SIDP,CODP,SIFP,COFP | |
12886 | COMMON /POPCMS/ ECMP,PCMP,PMASSP(2),PVIRTP(2),GAMBEP(4), | |
12887 | & SIDP,CODP,SIFP,COFP,NPOSP(2), | |
12888 | & IDPDG1,IDBAM1,IDPDG2,IDBAM2 | |
12889 | C obsolete cut-off information | |
12890 | DOUBLE PRECISION PTCUT,PTANO,FPS,FPH,PSOMIN,XSOMIN | |
12891 | COMMON /POCUT1/ PTCUT(4),PTANO(4),FPS(4),FPH(4),PSOMIN,XSOMIN | |
12892 | C energy-interpolation table | |
12893 | INTEGER IEETA2 | |
12894 | PARAMETER ( IEETA2 = 20 ) | |
12895 | INTEGER ISIMAX | |
12896 | DOUBLE PRECISION SIGTAB,SIGECM | |
12897 | COMMON /POTABL/ SIGTAB(4,80,IEETA2),SIGECM(4,IEETA2),ISIMAX | |
12898 | C light-cone x fractions and c.m. momenta of soft cut string ends | |
12899 | INTEGER MAXSOF | |
12900 | PARAMETER ( MAXSOF = 50 ) | |
12901 | INTEGER IJSI2,IJSI1 | |
12902 | DOUBLE PRECISION XS1,XS2,PSOFT1,PSOFT2 | |
12903 | COMMON /POSOFT/ XS1(MAXSOF),XS2(MAXSOF), | |
12904 | & PSOFT1(4,MAXSOF),PSOFT2(4,MAXSOF), | |
12905 | & IJSI1(MAXSOF),IJSI2(MAXSOF) | |
12906 | C standard particle data interface | |
12907 | INTEGER NMXHEP | |
12908 | PARAMETER (NMXHEP=4000) | |
12909 | INTEGER NEVHEP,NHEP,ISTHEP,IDHEP,JMOHEP,JDAHEP | |
12910 | DOUBLE PRECISION PHEP,VHEP | |
12911 | COMMON /POEVT1/ NEVHEP,NHEP,ISTHEP(NMXHEP),IDHEP(NMXHEP), | |
12912 | & JMOHEP(2,NMXHEP),JDAHEP(2,NMXHEP),PHEP(5,NMXHEP), | |
12913 | & VHEP(4,NMXHEP) | |
12914 | C extension to standard particle data interface (PHOJET specific) | |
12915 | INTEGER IMPART,IPHIST,ICOLOR | |
12916 | COMMON /POEVT2/ IMPART(NMXHEP),IPHIST(2,NMXHEP),ICOLOR(2,NMXHEP) | |
12917 | C table of particle indices for recursive PHOJET calls | |
12918 | INTEGER MAXIPX | |
12919 | PARAMETER ( MAXIPX = 100 ) | |
12920 | INTEGER IPOPOS,IPORES,IPOIX1,IPOIX2,IPOIX3 | |
12921 | COMMON /PORECU/ IPOPOS(2,MAXIPX),IPORES(MAXIPX), | |
12922 | & IPOIX1,IPOIX2,IPOIX3 | |
12923 | ||
12924 | DIMENSION P1(4),P2(4),WGXHSD(2),WGX(6) | |
12925 | ||
12926 | IREJ = 0 | |
12927 | ISWAP = 0 | |
12928 | JM1 = NPOSP(1) | |
12929 | JM2 = NPOSP(2) | |
12930 | INDX1 = IND1 | |
12931 | INDX2 = IND2 | |
12932 | EA1 = XS1(IND1)*ECMP/2.D0 | |
12933 | EA2 = XS1(IND1+1)*ECMP/2.D0 | |
12934 | EB1 = XS2(IND2)*ECMP/2.D0 | |
12935 | EB2 = XS2(IND2+1)*ECMP/2.D0 | |
12936 | CMASS1 = MIN(EA1,EA2) | |
12937 | CMASS2 = MIN(EB1,EB2) | |
12938 | ||
12939 | C debug output | |
12940 | IF(IDEB(9).GE.20) THEN | |
12941 | WRITE(LO,'(1X,2A,5I4)') 'PHO_POSPOM: ', | |
12942 | & 'IP,IND1,IND2,KCUT,IPOIX1',IP,IND1,IND2,KCUT,IPOIX1 | |
12943 | WRITE(LO,'(1X,A,2I4,1P2E12.4)') 'MOTHER1/2,MASS1/2',JM1,JM2, | |
12944 | & CMASS1,CMASS2 | |
12945 | ENDIF | |
12946 | ||
12947 | C flavours | |
12948 | IF(IND1.EQ.1) THEN | |
12949 | CALL PHO_VALFLA(JM1,IFLA1,IFLA2,EA1,EA2) | |
12950 | ELSE | |
12951 | CALL PHO_SEAFLA(JM1,IFLA1,IFLA2,CMASS1) | |
12952 | ENDIF | |
12953 | IF(IND2.EQ.1) THEN | |
12954 | CALL PHO_VALFLA(JM2,IFLB1,IFLB2,EB1,EB2) | |
12955 | ELSE | |
12956 | CALL PHO_SEAFLA(JM2,IFLB1,IFLB2,CMASS2) | |
12957 | ENDIF | |
12958 | DO 75 I=1,4 | |
12959 | P1(I) = PSOFT1(I,IND1)+PSOFT1(I,IND1+1) | |
12960 | P2(I) = PSOFT2(I,IND2)+PSOFT2(I,IND2+1) | |
12961 | 75 CONTINUE | |
12962 | ||
12963 | C pomeron resolved? | |
12964 | IF((ISWMDL(14).GT.0).AND.(IPOIX1.GT.0)) THEN | |
12965 | C find energy for cross section calculation | |
12966 | IF(IPAMDL(16).EQ.2) THEN | |
12967 | ESUB = ECMP | |
12968 | ELSE IF(IPAMDL(16).EQ.3) THEN | |
12969 | IF(IPROCE.EQ.1) THEN | |
12970 | ESUB = ECM | |
12971 | ELSE | |
12972 | ESUB = ECMP | |
12973 | ENDIF | |
12974 | ELSE | |
12975 | ESUB = SQRT((P1(4)+P2(4))**2-(P1(1)+P2(1))**2 | |
12976 | & -(P1(2)+P2(2))**2-(P1(3)+P2(3))**2) | |
12977 | ENDIF | |
12978 | C load cross sections from interpolation table | |
12979 | IF(ESUB.LE.SIGECM(IP,1)) THEN | |
12980 | I1 = 1 | |
12981 | I2 = 2 | |
12982 | ELSE IF(ESUB.LT.SIGECM(IP,ISIMAX)) THEN | |
12983 | DO 50 I=2,ISIMAX | |
12984 | IF(ESUB.LE.SIGECM(IP,I)) GOTO 200 | |
12985 | 50 CONTINUE | |
12986 | 200 CONTINUE | |
12987 | I1 = I-1 | |
12988 | I2 = I | |
12989 | ELSE | |
12990 | WRITE(LO,'(/1X,A,2E12.3)') | |
12991 | & 'PHO_POSPOM: energy too high',ESUB,SIGECM(IP,ISIMAX) | |
12992 | CALL PHO_PREVNT(-1) | |
12993 | I1 = ISIMAX-1 | |
12994 | I2 = ISIMAX | |
12995 | ENDIF | |
12996 | FAC2=0.D0 | |
12997 | IF(I1.NE.I2) FAC2=LOG(ESUB/SIGECM(IP,I1)) | |
12998 | & /LOG(SIGECM(IP,I2)/SIGECM(IP,I1)) | |
12999 | FAC1=1.D0-FAC2 | |
13000 | C calculate weights | |
13001 | * WGXHSD(1) = FAC2*SIGTAB(IP,32,I2)+FAC1*SIGTAB(IP,32,I1) | |
13002 | * WGXHSD(2) = FAC2*SIGTAB(IP,33,I2)+FAC1*SIGTAB(IP,33,I1) | |
13003 | * WGXHDD = FAC2*SIGTAB(IP,35,I2)+FAC1*SIGTAB(IP,35,I1) | |
13004 | * WGXCDF = FAC2*SIGTAB(IP,36,I2)+FAC1*SIGTAB(IP,36,I1) | |
13005 | * WGXPOM = FAC2*SIGTAB(IP,37,I2)+FAC1*SIGTAB(IP,37,I1) | |
13006 | * WGX(1) = WGXPOM-3.D0*(WGXHSD(1)+WGXHSD(2)+WGXHDD)+15.D0*WGXCDF | |
13007 | ||
13008 | WGXPOM = FAC2*(SIGTAB(IP,56,I2)+SIGTAB(IP,57,I2)) | |
13009 | & +FAC1*(SIGTAB(IP,56,I1)+SIGTAB(IP,57,I1)) | |
13010 | WGXHSD(1) = FAC2*SIGTAB(IP,60,I2)+FAC1*SIGTAB(IP,60,I1) | |
13011 | WGXHSD(2) = FAC2*SIGTAB(IP,62,I2)+FAC1*SIGTAB(IP,62,I1) | |
13012 | WGXHDD = FAC2*(SIGTAB(IP,61,I2)+SIGTAB(IP,63,I2) | |
13013 | & +SIGTAB(IP,64,I2)) | |
13014 | & +FAC1*(SIGTAB(IP,61,I1)+SIGTAB(IP,63,I1) | |
13015 | & +SIGTAB(IP,64,I1)) | |
13016 | WGXCDF = FAC2*(SIGTAB(IP,65,I2)+SIGTAB(IP,66,I2) | |
13017 | & +SIGTAB(IP,67,I2)+SIGTAB(IP,68,I2)) | |
13018 | & +FAC1*(SIGTAB(IP,65,I1)+SIGTAB(IP,66,I1) | |
13019 | & +SIGTAB(IP,67,I1)+SIGTAB(IP,68,I1)) | |
13020 | ||
13021 | C one-pomeron cut | |
13022 | WGX(1) = WGXPOM-3.D0*(WGXHSD(1)+WGXHSD(2)+WGXHDD)+15.D0*WGXCDF | |
13023 | C central diff. cut | |
13024 | WGX(2) = WGXCDF | |
13025 | C diff. diss. of particle 1 | |
13026 | WGX(3) = WGXHSD(1) | |
13027 | C diff. diss. of particle 2 | |
13028 | WGX(4) = WGXHSD(2) | |
13029 | C double diff. dissociation | |
13030 | WGX(5) = WGXHDD | |
13031 | C two-pomeron cut | |
13032 | WGX(6) = 2.D0*(WGXHSD(1)+WGXHSD(2)+WGXHDD) | |
13033 | ||
13034 | * IF((WGX(1).LT.0.D0).AND.((IP.EQ.1).OR.(IDEB(9).GE.1))) THEN | |
13035 | * WRITE(LO,'(1X,A,/1X,A,I3,1P,2E11.3)') ' PHO_POSPOM: ', | |
13036 | * & ' unitarity bound reached for ',IP,ESUB,WGX(1) | |
13037 | * WRITE(LO,'(5X,A)') 'WGXHSD(1),WGXHSD(2),WGXHDD,WGXCDF,WGXPOM:' | |
13038 | * WRITE(LO,'(5X,1P5E11.3)') WGXHSD,WGXHDD,WGXCDF,WGXPOM | |
13039 | * WRITE(LO,'(5X,A,/,5X,1P,6E11.3)') 'weight factors WG(1-6)',WGX | |
13040 | * ENDIF | |
13041 | ||
13042 | SUM = WGX(1)+WGX(2)+WGX(3)+WGX(4)+WGX(5)+WGX(6) | |
13043 | ||
13044 | C selection loop | |
13045 | 205 CONTINUE | |
13046 | XI = DT_RNDM(SUM)*SUM | |
13047 | I = 0 | |
13048 | SUM = 0.D0 | |
13049 | 210 CONTINUE | |
13050 | I = I+1 | |
13051 | SUM = SUM+WGX(I) | |
13052 | IF((XI.GT.SUM).AND.(I.LT.6)) GOTO 210 | |
13053 | C phase space correction | |
13054 | IF(I.NE.1) THEN | |
13055 | ISAM = 4 | |
13056 | IF(I.EQ.6) ISAM = 8 | |
13057 | PACC = EXP(-PARMDL(8)*DBLE(ISAM*PARMDL(160+IP))/ESUB) | |
13058 | * IF(DT_RNDM(SUM).GT.PACC) I=1 | |
13059 | IF(DT_RNDM(SUM).GT.PACC) GOTO 205 | |
13060 | ENDIF | |
13061 | ||
13062 | C do not generate diffraction for events with only one cut pomeron | |
13063 | IF((KCUT.EQ.1).AND.(I.LT.6)) I = 1 | |
13064 | ||
13065 | C do not generate recursive calls for remants with | |
13066 | C diquark-anti-diquark flavour contents | |
13067 | if((abs(IFLA1).gt.1000).and.(IFLA1+IFLA2.eq.0)) I = 1 | |
13068 | if((abs(IFLB1).gt.1000).and.(IFLB1+IFLB2.eq.0)) I = 1 | |
13069 | ||
13070 | C debug output | |
13071 | IF(IDEB(9).GE.20) WRITE(LO,'(1X,A,/1X,I2,1P7E11.3)') | |
13072 | & 'PHO_POSPOM: IPRO,ESUB,WGX(1-6)',I,ESUB,WGX | |
13073 | ||
13074 | IF(I.GT.1) THEN | |
13075 | C second scattering needed | |
13076 | CALL PHO_HACODE(IFLA1,IFLA2,IDHA1,IDUM) | |
13077 | CALL PHO_HACODE(IFLB1,IFLB2,IDHA2,IDUM) | |
13078 | IDPD1 = IPHO_ID2PDG(IDHA1) | |
13079 | IDPD2 = IPHO_ID2PDG(IDHA2) | |
13080 | ||
13081 | if(INDX1.eq.1) then | |
13082 | if((IPHIST(2,JM1).GE.0).and.(IDHEP(JM1).NE.990)) | |
13083 | & IGEN_had = IGEN | |
13084 | else | |
13085 | IGEN_had = -IGEN | |
13086 | endif | |
13087 | CALL PHO_REGPAR(1,IDPD1,IDHA1,JM1,JM2,P1(1),P1(2),P1(3),P1(4), | |
13088 | & IPOM,IGEN_had,0,0,IPOS1,1) | |
13089 | ||
13090 | if(INDX2.eq.1) then | |
13091 | if((IPHIST(2,JM2).GE.0).and.(IDHEP(JM2).NE.990)) | |
13092 | & IGEN_had = IGEN | |
13093 | else | |
13094 | IGEN_had = -IGEN | |
13095 | endif | |
13096 | CALL PHO_REGPAR(1,IDPD2,IDHA2,JM2,JM1,P2(1),P2(2),P2(3),P2(4), | |
13097 | & IPOM,IGEN_had,0,0,IPOS1,1) | |
13098 | ||
13099 | IND1 = IND1+2 | |
13100 | IND2 = IND2+2 | |
13101 | C update index | |
13102 | IPOIX2 = IPOIX2+1 | |
13103 | IF(IPOIX2.GT.MAXIPX) THEN | |
13104 | WRITE(LO,'(1X,2A,2I5)') 'PHO_POSPOM: no space left in ', | |
13105 | & '/PORECU/ (IPOIX2,MAXIPX):',IPOIX2,MAXIPX | |
13106 | IREJ = 1 | |
13107 | RETURN | |
13108 | ENDIF | |
13109 | IPORES(IPOIX2) = I+2 | |
13110 | IPOPOS(1,IPOIX2) = IPOS1-1 | |
13111 | IPOPOS(2,IPOIX2) = IPOS1 | |
13112 | RETURN | |
13113 | ENDIF | |
13114 | ENDIF | |
13115 | ||
13116 | 100 CONTINUE | |
13117 | IF(ISWMDL(12).EQ.0) THEN | |
13118 | C sample colors | |
13119 | CALL PHO_SELCOL(0,0,ICA1,ICA2,ICB1,ICB2,1) | |
13120 | CALL PHO_SELCOL(0,0,ICC1,ICC2,ICD1,ICD2,1) | |
13121 | ||
13122 | C purely gluonic pomeron or sea strings formed by gluons | |
13123 | ||
13124 | IF( ((IDHEP(JM1).EQ.990).AND.(IPAMDL(20).GT.0)) | |
13125 | & .OR.((IPAMDL(19).EQ.1).AND.(IND1.NE.1))) THEN | |
13126 | IFLA1 = 21 | |
13127 | IFLA2 = 21 | |
13128 | ENDIF | |
13129 | IF( ((IDHEP(JM2).EQ.990).AND.(IPAMDL(20).GT.0)) | |
13130 | & .OR.((IPAMDL(19).EQ.1).AND.(IND2.NE.1))) THEN | |
13131 | IFLB1 = 21 | |
13132 | IFLB2 = 21 | |
13133 | ENDIF | |
13134 | ||
13135 | C color connection | |
13136 | IF(IFLA1.NE.21) THEN | |
13137 | IF(((ABS(IFLA1).GT.6).AND.(IFLA1.GT.0)) | |
13138 | & .OR.((ABS(IFLA1).LE.6).AND.(IFLA1.LT.0))) | |
13139 | & CALL PHO_SWAPI(ICA1,ICD1) | |
13140 | ENDIF | |
13141 | IF(IFLB1.NE.21) THEN | |
13142 | IF(((ABS(IFLB1).GT.6).AND.(IFLB1.LT.0)) | |
13143 | & .OR.((ABS(IFLB1).LE.6).AND.(IFLB1.GT.0))) | |
13144 | & CALL PHO_SWAPI(ICB1,ICC1) | |
13145 | ENDIF | |
13146 | ISWAP = 0 | |
13147 | IF(ICA1*ICB1.GT.0) THEN | |
13148 | IF((IND1.NE.1).AND.(IND2.NE.1)) THEN | |
13149 | IF(DT_RNDM(CMASS1).GT.0.5D0) THEN | |
13150 | CALL PHO_SWAPI(IFLA1,IFLA2) | |
13151 | CALL PHO_SWAPI(ICA1,ICD1) | |
13152 | ELSE | |
13153 | CALL PHO_SWAPI(IFLB1,IFLB2) | |
13154 | CALL PHO_SWAPI(ICB1,ICC1) | |
13155 | ENDIF | |
13156 | ELSE IF(IND1.NE.1) THEN | |
13157 | CALL PHO_SWAPI(IFLA1,IFLA2) | |
13158 | CALL PHO_SWAPI(ICA1,ICD1) | |
13159 | ELSE IF(IND2.NE.1) THEN | |
13160 | CALL PHO_SWAPI(IFLB1,IFLB2) | |
13161 | CALL PHO_SWAPI(ICB1,ICC1) | |
13162 | ELSE IF((IFLA1.EQ.-IFLA2).AND.(IFLB1.EQ.-IFLB2)) THEN | |
13163 | IF(DT_RNDM(CMASS1).GT.0.5D0) THEN | |
13164 | CALL PHO_SWAPI(IFLA1,IFLA2) | |
13165 | CALL PHO_SWAPI(ICA1,ICD1) | |
13166 | ELSE | |
13167 | CALL PHO_SWAPI(IFLB1,IFLB2) | |
13168 | CALL PHO_SWAPI(ICB1,ICC1) | |
13169 | ENDIF | |
13170 | ELSE IF(IFLA1.EQ.-IFLA2) THEN | |
13171 | CALL PHO_SWAPI(IFLA1,IFLA2) | |
13172 | CALL PHO_SWAPI(ICA1,ICD1) | |
13173 | ELSE IF(IFLB1.EQ.-IFLB2) THEN | |
13174 | CALL PHO_SWAPI(IFLB1,IFLB2) | |
13175 | CALL PHO_SWAPI(ICB1,ICC1) | |
13176 | ELSE | |
13177 | ISWAP = 1 | |
13178 | IF(IDEB(9).GE.5) THEN | |
13179 | WRITE(LO,'(1X,A,I12)') | |
13180 | & 'PHO_POSPOM: string end swap (KEVENT)',KEVENT | |
13181 | WRITE(LO,'(5X,A,4I7)') | |
13182 | & 'flavors:',IFLA1,IFLA2,IFLB1,IFLB2 | |
13183 | WRITE(LO,'(5X,A,4I7)') 'colors :',ICA1,ICD1,ICB1,ICC1 | |
13184 | ENDIF | |
13185 | ENDIF | |
13186 | ENDIF | |
13187 | ||
13188 | C registration | |
13189 | ||
13190 | C purely gluonic pomeron or sea strings formed by gluons | |
13191 | IF(IFLA1.EQ.21) THEN | |
13192 | CALL PHO_REGPAR(-1,21,0,JM1,JM2,P1(1),P1(2),P1(3),P1(4), | |
13193 | & IPOM,IGEN,ICA1,ICD1,IPOS1,1) | |
13194 | IND1 = IND1+2 | |
13195 | ||
13196 | C strings formed by quarks | |
13197 | ELSE | |
13198 | C valence quark labels | |
13199 | IF((INDX1.EQ.1).and.(IPHIST(2,JM1).GE.0) | |
13200 | & .and.(IDHEP(JM1).NE.990)) THEN | |
13201 | ICA2 = 1 | |
13202 | ICD2 = 1 | |
13203 | ENDIF | |
13204 | C registration | |
13205 | CALL PHO_REGPAR(-1,IFLA1,0,JM1,JM2,PSOFT1(1,IND1), | |
13206 | & PSOFT1(2,IND1),PSOFT1(3,IND1),PSOFT1(4,IND1),IPOM,IGEN,ICA1, | |
13207 | & ICA2,IPOS1,1) | |
13208 | IND1 = IND1+1 | |
13209 | CALL PHO_REGPAR(-1,IFLA2,0,JM1,JM2,PSOFT1(1,IND1), | |
13210 | & PSOFT1(2,IND1),PSOFT1(3,IND1),PSOFT1(4,IND1),IPOM,IGEN,ICD1, | |
13211 | & ICD2,IPOS,1) | |
13212 | IND1 = IND1+1 | |
13213 | ENDIF | |
13214 | ||
13215 | C purely gluonic pomeron or sea strings formed by gluons | |
13216 | IF(IFLB1.EQ.21) THEN | |
13217 | CALL PHO_REGPAR(-1,IFLB1,0,JM2,JM1,P2(1),P2(2),P2(3),P2(4), | |
13218 | & IPOM,IGEN,ICB1,ICC1,IPOS2,1) | |
13219 | IND2 = IND2+2 | |
13220 | ||
13221 | C strings formed by quarks | |
13222 | ELSE | |
13223 | C valence quark labels | |
13224 | IF((INDX2.EQ.1).and.(IPHIST(2,JM2).GE.0) | |
13225 | & .and.(IDHEP(JM2).NE.990)) THEN | |
13226 | ICB2 = 1 | |
13227 | ICC2 = 1 | |
13228 | ENDIF | |
13229 | C registration | |
13230 | CALL PHO_REGPAR(-1,IFLB1,0,JM2,JM1,PSOFT2(1,IND2), | |
13231 | & PSOFT2(2,IND2),PSOFT2(3,IND2),PSOFT2(4,IND2),IPOM,IGEN,ICB1, | |
13232 | & ICB2,IPOS,1) | |
13233 | IND2 = IND2+1 | |
13234 | CALL PHO_REGPAR(-1,IFLB2,0,JM2,JM1,PSOFT2(1,IND2), | |
13235 | & PSOFT2(2,IND2),PSOFT2(3,IND2),PSOFT2(4,IND2),IPOM,IGEN,ICC1, | |
13236 | & ICC2,IPOS2,1) | |
13237 | IND2 = IND2+1 | |
13238 | ENDIF | |
13239 | ||
13240 | C soft pt assignment | |
13241 | IF(ISWMDL(18).EQ.0) THEN | |
13242 | CALL PHO_PARTPT(0,IPOS1,IPOS2,PTCUT(IP),IREJ) | |
13243 | IF(IREJ.NE.0) THEN | |
13244 | IFAIL(25) = IFAIL(25)+1 | |
13245 | RETURN | |
13246 | ENDIF | |
13247 | ENDIF | |
13248 | ELSE | |
13249 | * CALL PHO_BFKL(P1,P2,IPART,IREJ) | |
13250 | * IF(IREJ.NE.0) RETURN | |
13251 | ENDIF | |
13252 | ||
13253 | END | |
13254 | ||
13255 | *$ CREATE PHO_HADSP2.FOR | |
13256 | *COPY PHO_HADSP2 | |
13257 | CDECK ID>, PHO_HADSP2 | |
13258 | SUBROUTINE PHO_HADSP2(IFLB,XS1,XMAX,XSOFT1,IREJ) | |
13259 | C*********************************************************************** | |
13260 | C | |
13261 | C split hadron momentum XMAX into two partons using | |
13262 | C lower cut-off: AS | |
13263 | C | |
13264 | C input: IFLB compressed particle code of particle to split | |
13265 | C XS1 sum of x values already selected | |
13266 | C XMAX maximal x possible | |
13267 | C | |
13268 | C output: XS1 new sum of x values (without first one) | |
13269 | C XSOFT1 field of selected x values | |
13270 | C | |
13271 | C********************************************************************** | |
13272 | IMPLICIT DOUBLE PRECISION (A-H,O-Z) | |
13273 | SAVE | |
13274 | ||
13275 | PARAMETER ( DEPS = 1.D-8 ) | |
13276 | ||
13277 | DIMENSION XSOFT1(50) | |
13278 | ||
13279 | C input/output channels | |
13280 | INTEGER LI,LO | |
13281 | COMMON /POINOU/ LI,LO | |
13282 | C event debugging information | |
13283 | INTEGER NMAXD | |
13284 | PARAMETER (NMAXD=100) | |
13285 | INTEGER IDEB,KSPOM,KHPOM,KSREG,KHDIR,KACCEP,KSTRG,KHTRG,KSLOO, | |
13286 | & KHLOO,KSDPO,KHDPO,KEVENT,KSOFT,KHARD | |
13287 | COMMON /PODEBG/ IDEB(NMAXD),KSPOM,KHPOM,KSREG,KHDIR,KACCEP,KSTRG, | |
13288 | & KHTRG,KSLOO,KHLOO,KSDPO,KHDPO,KEVENT,KSOFT,KHARD | |
13289 | C internal rejection counters | |
13290 | INTEGER NMXJ | |
13291 | PARAMETER (NMXJ=60) | |
13292 | CHARACTER*10 REJTIT | |
13293 | INTEGER IFAIL | |
13294 | COMMON /POLOOP/ IFAIL(NMXJ),REJTIT(NMXJ) | |
13295 | C data on most recent hard scattering | |
13296 | INTEGER IA,IB,IC,ID,IV1,IV2,MSPR,IREJSC | |
13297 | DOUBLE PRECISION PTWANT,AS,AH,ALNS,ALNH,Z1MAX,Z1DIF,Z2MAX,Z2DIF, | |
13298 | & PT,PTfin,ETAC,ETAD,X1,X2,V,U,W,W1,AXX,QQPD,QQAL, | |
13299 | & PDF1,PDF2,WEIGHT,PHI1,PHI2,PHO1,PHO2 | |
13300 | COMMON /POCKIN/ PTWANT,AS,AH,ALNS,ALNH,Z1MAX,Z1DIF,Z2MAX,Z2DIF, | |
13301 | & PT,PTfin,ETAC,ETAD,X1,X2,V,U,W,W1,AXX, | |
13302 | & QQPD,QQAL,PDF1(-6:6),PDF2(-6:6),WEIGHT, | |
13303 | & PHI1(5),PHI2(5),PHO1(5),PHO2(5), | |
13304 | & IA,IB,IC,ID,IV1,IV2,MSPR,IREJSC | |
13305 | ||
13306 | C model exponents | |
13307 | DATA PVMES1 /-0.5D0/ | |
13308 | DATA PVMES2 /-0.5D0/ | |
13309 | DATA PVBAR1 / 1.5D0/ | |
13310 | DATA PVBAR2 /-0.5D0/ | |
13311 | C | |
13312 | IREJ = 0 | |
13313 | ITMAX = 100 | |
13314 | C | |
13315 | C mesonic particle | |
13316 | IF(ipho_bar3(IFLB,0).EQ.0) THEN | |
13317 | XPOT1 = PVMES1+1.D0 | |
13318 | XPOT2 = PVMES2+1.D0 | |
13319 | C baryonic particle | |
13320 | ELSE | |
13321 | XPOT1 = PVBAR1+1.D0 | |
13322 | XPOT2 = PVBAR2+1.D0 | |
13323 | ENDIF | |
13324 | ITER = 0 | |
13325 | XREST= 1.D0-XS1 | |
13326 | C selection loop | |
13327 | 100 CONTINUE | |
13328 | ITER = ITER+1 | |
13329 | IF(ITER.GE.ITMAX) THEN | |
13330 | IF(IDEB(39).GE.3) THEN | |
13331 | WRITE(LO,'(1X,A,I8)') | |
13332 | & 'PHO_HADSP2: REJECTION (ITER)',ITER | |
13333 | WRITE(LO,'(5X,A,3E12.3)') 'XS1,XMAX,AS:',XS1,XMAX,AS | |
13334 | ENDIF | |
13335 | IFAIL(14) = IFAIL(14)+1 | |
13336 | IREJ = 1 | |
13337 | RETURN | |
13338 | ENDIF | |
13339 | ZZ = XREST*PHO_RNDBET(XPOT2,XPOT1) | |
13340 | IF((ZZ.GT.XMAX).OR.(ZZ.LT.AS)) GOTO 100 | |
13341 | XSS1 = XS1 + ZZ | |
13342 | IF((1.D0-XSS1).LT.AS) GOTO 100 | |
13343 | C | |
13344 | XS1 = XSS1 | |
13345 | XSOFT1(1) = 1.D0-XSS1 | |
13346 | XSOFT1(2) = ZZ | |
13347 | C debug output | |
13348 | IF(IDEB(39).GE.10) THEN | |
13349 | WRITE(LO,'(1X,A,2I8)') 'PHO_HADSP2: ITMAX,ITER',ITMAX,ITER | |
13350 | WRITE(LO,'(5X,A,3E10.3,5X,2E11.4)') 'XS1,XMAX,AS X1,X2:', | |
13351 | & XS1,XMAX,AS,XSOFT1(1),XSOFT1(2) | |
13352 | ENDIF | |
13353 | END | |
13354 | ||
13355 | *$ CREATE PHO_HADSP3.FOR | |
13356 | *COPY PHO_HADSP3 | |
13357 | CDECK ID>, PHO_HADSP3 | |
13358 | SUBROUTINE PHO_HADSP3(IFLB,XS1,XMAX,XSOFT1,IREJ) | |
13359 | C*********************************************************************** | |
13360 | C | |
13361 | C split hadron momentum XMAX into diquark & quark pair | |
13362 | C using lower cut-off: AS | |
13363 | C | |
13364 | C input: IFLB compressed particle code of particle to split | |
13365 | C XS1 sum of x values already selected | |
13366 | C XMAX maximal x possible | |
13367 | C | |
13368 | C output: XS1 new sum of x values | |
13369 | C XSOFT1 field of selected x values | |
13370 | C | |
13371 | C | |
13372 | C********************************************************************** | |
13373 | IMPLICIT DOUBLE PRECISION (A-H,O-Z) | |
13374 | SAVE | |
13375 | PARAMETER ( DEPS = 1.D-8 ) | |
13376 | ||
13377 | DIMENSION XSOFT1(50),XSOFT2(50) | |
13378 | ||
13379 | C input/output channels | |
13380 | INTEGER LI,LO | |
13381 | COMMON /POINOU/ LI,LO | |
13382 | C event debugging information | |
13383 | INTEGER NMAXD | |
13384 | PARAMETER (NMAXD=100) | |
13385 | INTEGER IDEB,KSPOM,KHPOM,KSREG,KHDIR,KACCEP,KSTRG,KHTRG,KSLOO, | |
13386 | & KHLOO,KSDPO,KHDPO,KEVENT,KSOFT,KHARD | |
13387 | COMMON /PODEBG/ IDEB(NMAXD),KSPOM,KHPOM,KSREG,KHDIR,KACCEP,KSTRG, | |
13388 | & KHTRG,KSLOO,KHLOO,KSDPO,KHDPO,KEVENT,KSOFT,KHARD | |
13389 | C internal rejection counters | |
13390 | INTEGER NMXJ | |
13391 | PARAMETER (NMXJ=60) | |
13392 | CHARACTER*10 REJTIT | |
13393 | INTEGER IFAIL | |
13394 | COMMON /POLOOP/ IFAIL(NMXJ),REJTIT(NMXJ) | |
13395 | C data of c.m. system of Pomeron / Reggeon exchange | |
13396 | INTEGER NPOSP,IDPDG1,IDBAM1,IDPDG2,IDBAM2 | |
13397 | DOUBLE PRECISION ECMP,PCMP,PMASSP,PVIRTP,GAMBEP, | |
13398 | & SIDP,CODP,SIFP,COFP | |
13399 | COMMON /POPCMS/ ECMP,PCMP,PMASSP(2),PVIRTP(2),GAMBEP(4), | |
13400 | & SIDP,CODP,SIFP,COFP,NPOSP(2), | |
13401 | & IDPDG1,IDBAM1,IDPDG2,IDBAM2 | |
13402 | ||
13403 | DIMENSION XPOT1(3),XPOT2(3),XMIN(2,3) | |
13404 | ||
13405 | C model exponents | |
13406 | DATA PVMES1 /-0.5D0/ | |
13407 | DATA PVMES2 /-0.5D0/ | |
13408 | DATA PSMES /-0.99D0/ | |
13409 | DATA PVBAR1 / 1.5D0/ | |
13410 | DATA PVBAR2 /-0.5D0/ | |
13411 | DATA PSBAR /-0.99D0/ | |
13412 | C | |
13413 | IREJ = 0 | |
13414 | C | |
13415 | C determine exponents | |
13416 | C particle 1 | |
13417 | C | |
13418 | XMMIN = 0.3D0/ECMP | |
13419 | XBMIN = 1.6D0/ECMP | |
13420 | C mesonic particle | |
13421 | IF(ipho_bar3(IFLB,0).EQ.0) THEN | |
13422 | XPOT1(1) = PVMES1 | |
13423 | XMIN(1,1) = XMMIN | |
13424 | XPOT1(2) = PVMES2 | |
13425 | XMIN(1,2) = XMMIN | |
13426 | XPOT1(3) = PSMES | |
13427 | XMIN(1,3) = XMMIN | |
13428 | C baryonic particle | |
13429 | ELSE | |
13430 | XPOT1(1) = PVBAR1 | |
13431 | XMIN(1,1) = XBMIN | |
13432 | XPOT1(2) = PVBAR2 | |
13433 | XMIN(1,2) = XMMIN | |
13434 | XPOT1(3) = PSBAR | |
13435 | XMIN(1,3) = XMMIN | |
13436 | ENDIF | |
13437 | C particle 2 | |
13438 | C mesonic particle | |
13439 | XPOT2(1) = PVMES1 | |
13440 | XMIN(2,1) = XMMIN | |
13441 | XPOT2(2) = PVMES2 | |
13442 | XMIN(2,2) = XMMIN | |
13443 | XPOT2(3) = PSMES | |
13444 | XMIN(2,3) = XMMIN | |
13445 | C | |
13446 | XDUM1 = 0.01D0 | |
13447 | XDUM2 = 0.99D0 | |
13448 | CALL PHO_SELSXS(3,3,XPOT1,XPOT2,XMIN,XS1,XDUM1,XMAX,XDUM2, | |
13449 | & XSOFT1,XSOFT2,IREJ) | |
13450 | C rejection? | |
13451 | IF(IREJ.NE.0) THEN | |
13452 | IF(IDEB(74).GE.3) WRITE(LO,'(1X,A,I6,2E12.4)') | |
13453 | & 'PHO_HADSP3: rejection (IFLB,XS1,XMAX)',IFLB,XS1,XMAX | |
13454 | IFAIL(15) = IFAIL(15)+1 | |
13455 | IREJ = 1 | |
13456 | RETURN | |
13457 | ENDIF | |
13458 | C debug output | |
13459 | IF(IDEB(74).GE.10) THEN | |
13460 | WRITE(LO,'(1X,A,I6,2E12.4)') | |
13461 | & 'PHO_HADSP3: IFLB,XS1,XMAX',IFLB,XS1,XMAX | |
13462 | DO 100 I=1,3 | |
13463 | WRITE(LO,'(10X,I4,2E12.4)') I,XSOFT1(I),XSOFT2(I) | |
13464 | 100 CONTINUE | |
13465 | ENDIF | |
13466 | ||
13467 | END | |
13468 | ||
13469 | *$ CREATE PHO_SOFTXX.FOR | |
13470 | *COPY PHO_SOFTXX | |
13471 | CDECK ID>, PHO_SOFTXX | |
13472 | SUBROUTINE PHO_SOFTXX(JM1,JM2,MSPAR1,MSPAR2,IVAL1,IVAL2,MSM1,MSM2, | |
13473 | & XSUM1,XSUM2,XMAX1,XMAX2,XS1,XS2,IREJ) | |
13474 | C*********************************************************************** | |
13475 | C | |
13476 | C select soft x values | |
13477 | C | |
13478 | C input: JM1,JM2 mother particle index in POEVT1 | |
13479 | C (0 flavour not known before) | |
13480 | C MSPAR1,2 number of x values to select | |
13481 | C IVAL1,2 number valence quarks involved in hard | |
13482 | C scattering (0,1,2) | |
13483 | C MSM1,2 minimum number of soft x to get sampled | |
13484 | C XSUM1,2 sum of all x values samples up this call | |
13485 | C XMAX1,2 max. x value | |
13486 | C | |
13487 | C output XSUM1,2 new sum of x-values sampled | |
13488 | C XS1,2 field containing sampled x values | |
13489 | C | |
13490 | C x values of valence partons are first given | |
13491 | C | |
13492 | C*********************************************************************** | |
13493 | IMPLICIT DOUBLE PRECISION (A-H,O-Z) | |
13494 | SAVE | |
13495 | ||
13496 | C input/output channels | |
13497 | INTEGER LI,LO | |
13498 | COMMON /POINOU/ LI,LO | |
13499 | C event debugging information | |
13500 | INTEGER NMAXD | |
13501 | PARAMETER (NMAXD=100) | |
13502 | INTEGER IDEB,KSPOM,KHPOM,KSREG,KHDIR,KACCEP,KSTRG,KHTRG,KSLOO, | |
13503 | & KHLOO,KSDPO,KHDPO,KEVENT,KSOFT,KHARD | |
13504 | COMMON /PODEBG/ IDEB(NMAXD),KSPOM,KHPOM,KSREG,KHDIR,KACCEP,KSTRG, | |
13505 | & KHTRG,KSLOO,KHLOO,KSDPO,KHDPO,KEVENT,KSOFT,KHARD | |
13506 | C internal rejection counters | |
13507 | INTEGER NMXJ | |
13508 | PARAMETER (NMXJ=60) | |
13509 | CHARACTER*10 REJTIT | |
13510 | INTEGER IFAIL | |
13511 | COMMON /POLOOP/ IFAIL(NMXJ),REJTIT(NMXJ) | |
13512 | C model switches and parameters | |
13513 | CHARACTER*8 MDLNA | |
13514 | INTEGER ISWMDL,IPAMDL | |
13515 | DOUBLE PRECISION PARMDL | |
13516 | COMMON /POMDLS/ MDLNA(50),ISWMDL(50),PARMDL(400),IPAMDL(400) | |
13517 | C data of c.m. system of Pomeron / Reggeon exchange | |
13518 | INTEGER NPOSP,IDPDG1,IDBAM1,IDPDG2,IDBAM2 | |
13519 | DOUBLE PRECISION ECMP,PCMP,PMASSP,PVIRTP,GAMBEP, | |
13520 | & SIDP,CODP,SIFP,COFP | |
13521 | COMMON /POPCMS/ ECMP,PCMP,PMASSP(2),PVIRTP(2),GAMBEP(4), | |
13522 | & SIDP,CODP,SIFP,COFP,NPOSP(2), | |
13523 | & IDPDG1,IDBAM1,IDPDG2,IDBAM2 | |
13524 | C standard particle data interface | |
13525 | INTEGER NMXHEP | |
13526 | PARAMETER (NMXHEP=4000) | |
13527 | INTEGER NEVHEP,NHEP,ISTHEP,IDHEP,JMOHEP,JDAHEP | |
13528 | DOUBLE PRECISION PHEP,VHEP | |
13529 | COMMON /POEVT1/ NEVHEP,NHEP,ISTHEP(NMXHEP),IDHEP(NMXHEP), | |
13530 | & JMOHEP(2,NMXHEP),JDAHEP(2,NMXHEP),PHEP(5,NMXHEP), | |
13531 | & VHEP(4,NMXHEP) | |
13532 | C extension to standard particle data interface (PHOJET specific) | |
13533 | INTEGER IMPART,IPHIST,ICOLOR | |
13534 | COMMON /POEVT2/ IMPART(NMXHEP),IPHIST(2,NMXHEP),ICOLOR(2,NMXHEP) | |
13535 | C nucleon-nucleus / nucleus-nucleus interface to DPMJET | |
13536 | INTEGER IDEQP,IDEQB,IHFLD,IHFLS | |
13537 | DOUBLE PRECISION ECMN,PCMN,SECM,SPCM,XPSUB,XTSUB | |
13538 | COMMON /POHDFL/ ECMN,PCMN,SECM,SPCM,XPSUB,XTSUB, | |
13539 | & IDEQP(2),IDEQB(2),IHFLD(2,2),IHFLS(2) | |
13540 | C obsolete cut-off information | |
13541 | DOUBLE PRECISION PTCUT,PTANO,FPS,FPH,PSOMIN,XSOMIN | |
13542 | COMMON /POCUT1/ PTCUT(4),PTANO(4),FPS(4),FPH(4),PSOMIN,XSOMIN | |
13543 | C data on most recent hard scattering | |
13544 | INTEGER IA,IB,IC,ID,IV1,IV2,MSPR,IREJSC | |
13545 | DOUBLE PRECISION PTWANT,AS,AH,ALNS,ALNH,Z1MAX,Z1DIF,Z2MAX,Z2DIF, | |
13546 | & PT,PTfin,ETAC,ETAD,X1,X2,V,U,W,W1,AXX,QQPD,QQAL, | |
13547 | & PDF1,PDF2,WEIGHT,PHI1,PHI2,PHO1,PHO2 | |
13548 | COMMON /POCKIN/ PTWANT,AS,AH,ALNS,ALNH,Z1MAX,Z1DIF,Z2MAX,Z2DIF, | |
13549 | & PT,PTfin,ETAC,ETAD,X1,X2,V,U,W,W1,AXX, | |
13550 | & QQPD,QQAL,PDF1(-6:6),PDF2(-6:6),WEIGHT, | |
13551 | & PHI1(5),PHI2(5),PHO1(5),PHO2(5), | |
13552 | & IA,IB,IC,ID,IV1,IV2,MSPR,IREJSC | |
13553 | ||
13554 | DIMENSION XS1(*),XS2(*) | |
13555 | ||
13556 | INTEGER MAXPOT | |
13557 | PARAMETER ( MAXPOT = 50 ) | |
13558 | DIMENSION XPOT1(MAXPOT),XPOT2(MAXPOT),XMIN(2,MAXPOT) | |
13559 | ||
13560 | IREJ = 0 | |
13561 | ||
13562 | MSMAX = MAX(MSPAR1,MSPAR2) | |
13563 | MSMIN = MAX(MSM1,MSM2) | |
13564 | IF(MSMAX.GT.MAXPOT) THEN | |
13565 | WRITE(LO,'(1X,2A,2I4)') 'PHO_SOFTXX: no space left in ', | |
13566 | & 'local fields XPOT1/2 (MSMAX,MAXPOT):',MSMAX,MAXPOT | |
13567 | IREJ = 1 | |
13568 | RETURN | |
13569 | ENDIF | |
13570 | C determine exponents | |
13571 | IBAR1 = ipho_bar3(JM1,2) | |
13572 | IBAR2 = ipho_bar3(JM2,2) | |
13573 | ISWAP = 0 | |
13574 | IF((IBAR1*IBAR2).LT.0) ISWAP = 1 | |
13575 | C meson-baryon scattering (asymmetric sea) | |
13576 | IF((ABS(IBAR1)+ABS(IBAR2)).EQ.1) THEN | |
13577 | PSBAR = PARMDL(53) | |
13578 | PSMES = PARMDL(57) | |
13579 | ELSE | |
13580 | PSBAR = PARMDL(52) | |
13581 | PSMES = PARMDL(56) | |
13582 | ENDIF | |
13583 | ||
13584 | C lower limits for x sampling | |
13585 | XMMINA = 2.D0*PARMDL(157)/ECMP | |
13586 | XBMINA = 2.D0*PARMDL(158)/ECMP | |
13587 | XSMINA = 2.D0*PARMDL(159)/ECMP | |
13588 | XMIN1 = MAX(XSOMIN,AS/XMAX2) | |
13589 | XMIN2 = MAX(XSOMIN,AS/XMAX1) | |
13590 | XMAXP1 = MIN(1.D0-XMIN1*MSMAX,XMAX1) | |
13591 | XMAXP2 = MIN(1.D0-XMIN2*MSMAX,XMAX2) | |
13592 | XMIN1 = MAX(AS/XMAX2,XMIN1) | |
13593 | XMIN2 = MAX(AS/XMAX1,XMIN2) | |
13594 | ||
13595 | C particle 1 | |
13596 | XMMIN1 = MAX(XMIN1,XMMINA) | |
13597 | XBMIN1 = MAX(XMIN1,XBMINA) | |
13598 | XSMIN1 = MAX(XMIN1,XSMINA) | |
13599 | C mesonic particle | |
13600 | IF(IBAR1.EQ.0) THEN | |
13601 | IF(IHFLS(1).EQ.0) THEN | |
13602 | XPOT1(1) = PARMDL(62) | |
13603 | XMIN(1,1) = XSMIN1 | |
13604 | XPOT1(2) = PARMDL(63) | |
13605 | XMIN(1,2) = XSMIN1 | |
13606 | ELSE | |
13607 | XPOT1(1) = PARMDL(54) | |
13608 | XMIN(1,1) = XMMIN1 | |
13609 | XPOT1(2) = PARMDL(55) | |
13610 | XMIN(1,2) = XMMIN1 | |
13611 | ENDIF | |
13612 | DO 100 I=3-IVAL1,MSMAX | |
13613 | XPOT1(I) = PSMES | |
13614 | XMIN(1,I) = XSMIN1 | |
13615 | 100 CONTINUE | |
13616 | C baryonic particle | |
13617 | ELSE | |
13618 | IF(IHFLS(1).EQ.0) THEN | |
13619 | XPOT1(1) = PARMDL(62) | |
13620 | XMIN(1,1) = XSMIN1 | |
13621 | XPOT1(2) = PARMDL(63) | |
13622 | XMIN(1,2) = XSMIN1 | |
13623 | ELSE | |
13624 | XPOT1(1) = PARMDL(50) | |
13625 | XMIN(1,1) = XBMIN1 | |
13626 | XPOT1(2) = PARMDL(51) | |
13627 | XMIN(1,2) = XMMIN1 | |
13628 | ENDIF | |
13629 | DO 200 I=3-IVAL1,MSMAX | |
13630 | XPOT1(I) = PSBAR | |
13631 | XMIN(1,I) = XSMIN1 | |
13632 | 200 CONTINUE | |
13633 | ENDIF | |
13634 | ||
13635 | C particle 2 | |
13636 | XMMIN2 = MAX(XMIN2,XMMINA) | |
13637 | XBMIN2 = MAX(XMIN2,XBMINA) | |
13638 | XSMIN2 = MAX(XMIN2,XSMINA) | |
13639 | C mesonic particle | |
13640 | IF(IBAR2.EQ.0) THEN | |
13641 | IF(IHFLS(2).EQ.0) THEN | |
13642 | XPOT2(1) = PARMDL(62) | |
13643 | XMIN(2,1) = XSMIN2 | |
13644 | XPOT2(2) = PARMDL(63) | |
13645 | XMIN(2,2) = XSMIN2 | |
13646 | ELSE | |
13647 | XPOT2(1) = PARMDL(54) | |
13648 | XMIN(2,1) = XMMIN2 | |
13649 | XPOT2(2) = PARMDL(55) | |
13650 | XMIN(2,2) = XMMIN2 | |
13651 | ENDIF | |
13652 | DO 300 I=3-IVAL2,MSMAX | |
13653 | XPOT2(I) = PSMES | |
13654 | XMIN(2,I) = XSMIN2 | |
13655 | 300 CONTINUE | |
13656 | C baryonic particle | |
13657 | ELSE | |
13658 | IF(IHFLS(2).EQ.0) THEN | |
13659 | XPOT2(1) = PARMDL(62) | |
13660 | XMIN(2,1) = XSMIN2 | |
13661 | XPOT2(2) = PARMDL(63) | |
13662 | XMIN(2,2) = XSMIN2 | |
13663 | ELSE | |
13664 | XPOT2(1) = PARMDL(50) | |
13665 | XMIN(2,1) = XBMIN2 | |
13666 | XPOT2(2) = PARMDL(51) | |
13667 | XMIN(2,2) = XMMIN2 | |
13668 | ENDIF | |
13669 | DO 400 I=3-IVAL2,MSMAX | |
13670 | XPOT2(I) = PSBAR | |
13671 | XMIN(2,I) = XSMIN2 | |
13672 | 400 CONTINUE | |
13673 | ENDIF | |
13674 | ||
13675 | XSS1 = XSUM1 | |
13676 | XSS2 = XSUM2 | |
13677 | MSOFT = MSMAX | |
13678 | ||
13679 | C check limits (important for valences) | |
13680 | IF((XMIN(1,1).GE.XMAXP1).OR.(XMIN(1,2).GE.XMAXP1)) GOTO 1000 | |
13681 | IF((XMIN(2,1).GE.XMAXP2).OR.(XMIN(2,2).GE.XMAXP2)) GOTO 1000 | |
13682 | ||
13683 | XMINS1 = XSS1 | |
13684 | IF(IHFLS(1).NE.0) XMINS1 = XMINS1+(PARMDL(166)/ECMP)**2 | |
13685 | XMINS2 = XSS2 | |
13686 | IF(IHFLS(2).NE.0) XMINS2 = XMINS2+(PARMDL(166)/ECMP)**2 | |
13687 | DO 10 I=1,MSOFT | |
13688 | XMINS1 = XMINS1+XMIN(1,I) | |
13689 | XMINS2 = XMINS2+XMIN(2,I) | |
13690 | 10 CONTINUE | |
13691 | IF((XMINS1.GE.1.D0).OR.(XMINS2.GE.1.D0)) GOTO 1000 | |
13692 | ||
13693 | C try to sample x values | |
13694 | IF(IPAMDL(14).EQ.0) THEN | |
13695 | IF(MSOFT.EQ.2) THEN | |
13696 | CALL PHO_SELSX2(XPOT1,XPOT2,XMIN,XSS1,XSS2,XMAXP1,XMAXP2, | |
13697 | & XS1,XS2,IREJ) | |
13698 | ELSE IF(MSOFT.LT.5) THEN | |
13699 | CALL PHO_SELSXR(MSOFT,MSMIN,XPOT1,XPOT2,XMIN,XSS1,XSS2, | |
13700 | & XMAXP1,XMAXP2,XS1,XS2,IREJ) | |
13701 | ELSE | |
13702 | CALL PHO_SELSXS(MSOFT,MSMIN,XPOT1,XPOT2,XMIN,XSS1,XSS2, | |
13703 | & XMAXP1,XMAXP2,XS1,XS2,IREJ) | |
13704 | ENDIF | |
13705 | ELSE IF(IPAMDL(14).EQ.1) THEN | |
13706 | IF(MSOFT.EQ.2) THEN | |
13707 | CALL PHO_SELSX2(XPOT1,XPOT2,XMIN,XSS1,XSS2,XMAXP1,XMAXP2, | |
13708 | & XS1,XS2,IREJ) | |
13709 | ELSE | |
13710 | CALL PHO_SELSXS(MSOFT,MSMIN,XPOT1,XPOT2,XMIN,XSS1,XSS2, | |
13711 | & XMAXP1,XMAXP2,XS1,XS2,IREJ) | |
13712 | ENDIF | |
13713 | ELSE IF(IPAMDL(14).EQ.2) THEN | |
13714 | CALL PHO_SELSXS(MSOFT,MSMIN,XPOT1,XPOT2,XMIN,XSS1,XSS2, | |
13715 | & XMAXP1,XMAXP2,XS1,XS2,IREJ) | |
13716 | ELSE IF(IPAMDL(14).EQ.3) THEN | |
13717 | IF(MSOFT.EQ.2) THEN | |
13718 | CALL PHO_SELSX2(XPOT1,XPOT2,XMIN,XSS1,XSS2,XMAXP1,XMAXP2, | |
13719 | & XS1,XS2,IREJ) | |
13720 | ELSE IF(IVAL1+IVAL2.EQ.0) THEN | |
13721 | CALL PHO_SELSXI(MSOFT,MSMIN,XPOT1,XPOT2,XMIN,XSS1,XSS2, | |
13722 | & XMAXP1,XMAXP2,XS1,XS2,IREJ) | |
13723 | ELSE | |
13724 | CALL PHO_SELSXS(MSOFT,MSMIN,XPOT1,XPOT2,XMIN,XSS1,XSS2, | |
13725 | & XMAXP1,XMAXP2,XS1,XS2,IREJ) | |
13726 | ENDIF | |
13727 | ELSE | |
13728 | WRITE(LO,'(/,1X,A,I3)') | |
13729 | & 'PHO_SOFTXX:ERROR: unsupported IPAMDL(14)',IPAMDL(14) | |
13730 | STOP | |
13731 | ENDIF | |
13732 | IF(IREJ.NE.0) THEN | |
13733 | IFAIL(41) = IFAIL(41)+1 | |
13734 | IF(IDEB(60).GE.2) THEN | |
13735 | WRITE(LO,'(1X,A,I12,4I3)') | |
13736 | & 'PHO_SOFTXX: rejection: EVE,MSP1/2,MSM1/2', | |
13737 | & KEVENT,MSPAR1,MSPAR2,MSM1,MSM2 | |
13738 | WRITE(LO,'(1X,A,1P4E11.3)') 'XSUM1/2,XMAX1/2', | |
13739 | & XSUM1,XSUM2,XMAX1,XMAX2 | |
13740 | ENDIF | |
13741 | RETURN | |
13742 | ENDIF | |
13743 | IF(MSOFT.NE.MSMAX) THEN | |
13744 | MSDIFF = MSMAX-MSOFT | |
13745 | MSPAR1 = MSPAR1-MSDIFF | |
13746 | MSPAR2 = MSPAR2-MSDIFF | |
13747 | ENDIF | |
13748 | ||
13749 | C correct for different MSPAR numbers | |
13750 | IF(MSOFT.NE.MSPAR1) THEN | |
13751 | IF(MSPAR1.GT.1) THEN | |
13752 | XDEL = 0.D0 | |
13753 | DO 500 I=MSPAR1+1,MSOFT | |
13754 | XDEL = XDEL+XS1(I) | |
13755 | 500 CONTINUE | |
13756 | XFAC = (1.D0-XSUM1)/(1.D0-XDEL-XSUM1) | |
13757 | DO 550 I=2,MSPAR1 | |
13758 | XS1(I) = XS1(I)*XFAC | |
13759 | 550 CONTINUE | |
13760 | XSS1 = (XSS1-XDEL-XSUM1)*XFAC+XSUM1 | |
13761 | ELSE | |
13762 | XSS1 = XSUM1 | |
13763 | ENDIF | |
13764 | ENDIF | |
13765 | IF(MSOFT.NE.MSPAR2) THEN | |
13766 | IF(MSPAR2.GT.1) THEN | |
13767 | XDEL = 0.D0 | |
13768 | DO 600 I=MSPAR2+1,MSOFT | |
13769 | XDEL = XDEL+XS2(I) | |
13770 | 600 CONTINUE | |
13771 | XFAC = (1.D0-XSUM2)/(1.D0-XDEL-XSUM2) | |
13772 | DO 650 I=2,MSPAR2 | |
13773 | XS2(I) = XS2(I)*XFAC | |
13774 | 650 CONTINUE | |
13775 | XSS2 = (XSS2-XDEL-XSUM2)*XFAC+XSUM2 | |
13776 | ELSE | |
13777 | XSS2 = XSUM2 | |
13778 | ENDIF | |
13779 | ENDIF | |
13780 | ||
13781 | C first x entry | |
13782 | XS1(1) = 1.D0 - XSS1 | |
13783 | XS2(1) = 1.D0 - XSS2 | |
13784 | XSUM1 = XSS1 | |
13785 | XSUM2 = XSS2 | |
13786 | ||
13787 | C debug output | |
13788 | IF(IDEB(60).GE.10) THEN | |
13789 | WRITE(LO,'(1X,A,I8,2I4,2E12.4)') | |
13790 | & 'PHO_SOFTXX: EVE,MSPAR1/2,XSUM1/2:', | |
13791 | & KEVENT,MSPAR1,MSPAR2,XSUM1,XSUM2 | |
13792 | WRITE(LO,'(1X,A)') 'PHO_SOFTXX: I XS1/2 XPOT1/2 XMIN1/2' | |
13793 | DO 30 I=1,MSOFT | |
13794 | WRITE(LO,'(5X,I3,6E12.4)') I,XS1(I),XS2(I),XPOT1(I),XPOT2(I), | |
13795 | & XMIN(1,I),XMIN(2,I) | |
13796 | 30 CONTINUE | |
13797 | ENDIF | |
13798 | ||
13799 | RETURN | |
13800 | ||
13801 | C not enough phase space | |
13802 | 1000 CONTINUE | |
13803 | ||
13804 | IFAIL(42) = IFAIL(42)+1 | |
13805 | IREJ = 1 | |
13806 | ||
13807 | C warning message | |
13808 | IF(IDEB(60).GE.1) THEN | |
13809 | WRITE (6,'(1X,A,1P,2E11.3,/1X,A,/5X,6E11.3)') | |
13810 | & 'PHO_SOFTXX: Xmin>Xmax or sum(Xmin)>1 (ECM,AS)', | |
13811 | & ECMP,AS,'PHO_SOFTXX: Xmin1/2,Xmaxp1/2,sum(Xmin1/2)', | |
13812 | & XMIN1,XMIN2,XMAXP1,XMAXP2,XMINS1,XMINS2 | |
13813 | WRITE(LO,'(1X,A,1P,3E11.3)') | |
13814 | & 'PHO_SOFTXX: Xmmina,Xbmina,Xsmina:',XMMINA,XBMINA,XSMINA | |
13815 | WRITE(LO,'(1X,A,1P,3E11.3)') | |
13816 | & 'PHO_SOFTXX: Xmmin1,Xbmin1,Xsmin1:',XMMIN1,XBMIN1,XSMIN1 | |
13817 | WRITE(LO,'(1X,A,1P,3E11.3)') | |
13818 | & 'PHO_SOFTXX: Xmmin2,Xbmin2,Xsmin2:',XMMIN2,XBMIN2,XSMIN2 | |
13819 | WRITE(LO,'(1X,A)') | |
13820 | & 'PHO_SOFTXX: Table of lower x limits (I,Xmin(1,I),Xmin(2,I))' | |
13821 | DO 27 I=1,MSOFT | |
13822 | WRITE(LO,'(5X,I3,1P,2E11.3)') I,XMIN(1,I),XMIN(2,I) | |
13823 | 27 CONTINUE | |
13824 | WRITE(LO,'(1X,A,I10,2I4,2E11.3)') | |
13825 | & 'PHO_SOFTXX: KEVENT,MSPAR1/2,XSUM1/2:', | |
13826 | & KEVENT,MSPAR1,MSPAR2,XSUM1,XSUM2 | |
13827 | WRITE(LO,'(1X,A)') 'PHO_SOFTXX: I XPOT1/2 XMIN1/2' | |
13828 | DO 25 I=1,MSOFT | |
13829 | WRITE(LO,'(5X,I3,4E12.4)') I,XPOT1(I),XPOT2(I), | |
13830 | & XMIN(1,I),XMIN(2,I) | |
13831 | 25 CONTINUE | |
13832 | ENDIF | |
13833 | ||
13834 | END | |
13835 | ||
13836 | *$ CREATE PHO_SELSXR.FOR | |
13837 | *COPY PHO_SELSXR | |
13838 | CDECK ID>, PHO_SELSXR | |
13839 | SUBROUTINE PHO_SELSXR(MSOFT,MSMIN,XPOT1,XPOT2,XMIN,XS1,XS2, | |
13840 | & XMAX1,XMAX2,XSOFT1,XSOFT2,IREJ) | |
13841 | C*********************************************************************** | |
13842 | C | |
13843 | C select x values of soft string ends (rejection method) | |
13844 | C | |
13845 | C*********************************************************************** | |
13846 | IMPLICIT DOUBLE PRECISION (A-H,O-Z) | |
13847 | SAVE | |
13848 | ||
13849 | DIMENSION XPOT1(*),XPOT2(*),XMIN(2,*),XSOFT1(*),XSOFT2(*) | |
13850 | ||
13851 | C input/output channels | |
13852 | INTEGER LI,LO | |
13853 | COMMON /POINOU/ LI,LO | |
13854 | C event debugging information | |
13855 | INTEGER NMAXD | |
13856 | PARAMETER (NMAXD=100) | |
13857 | INTEGER IDEB,KSPOM,KHPOM,KSREG,KHDIR,KACCEP,KSTRG,KHTRG,KSLOO, | |
13858 | & KHLOO,KSDPO,KHDPO,KEVENT,KSOFT,KHARD | |
13859 | COMMON /PODEBG/ IDEB(NMAXD),KSPOM,KHPOM,KSREG,KHDIR,KACCEP,KSTRG, | |
13860 | & KHTRG,KSLOO,KHLOO,KSDPO,KHDPO,KEVENT,KSOFT,KHARD | |
13861 | C model switches and parameters | |
13862 | CHARACTER*8 MDLNA | |
13863 | INTEGER ISWMDL,IPAMDL | |
13864 | DOUBLE PRECISION PARMDL | |
13865 | COMMON /POMDLS/ MDLNA(50),ISWMDL(50),PARMDL(400),IPAMDL(400) | |
13866 | C data on most recent hard scattering | |
13867 | INTEGER IA,IB,IC,ID,IV1,IV2,MSPR,IREJSC | |
13868 | DOUBLE PRECISION PTWANT,AS,AH,ALNS,ALNH,Z1MAX,Z1DIF,Z2MAX,Z2DIF, | |
13869 | & PT,PTfin,ETAC,ETAD,X1,X2,V,U,W,W1,AXX,QQPD,QQAL, | |
13870 | & PDF1,PDF2,WEIGHT,PHI1,PHI2,PHO1,PHO2 | |
13871 | COMMON /POCKIN/ PTWANT,AS,AH,ALNS,ALNH,Z1MAX,Z1DIF,Z2MAX,Z2DIF, | |
13872 | & PT,PTfin,ETAC,ETAD,X1,X2,V,U,W,W1,AXX, | |
13873 | & QQPD,QQAL,PDF1(-6:6),PDF2(-6:6),WEIGHT, | |
13874 | & PHI1(5),PHI2(5),PHO1(5),PHO2(5), | |
13875 | & IA,IB,IC,ID,IV1,IV2,MSPR,IREJSC | |
13876 | C global event kinematics and particle IDs | |
13877 | INTEGER IFPAP,IFPAB | |
13878 | DOUBLE PRECISION ECM,PCM,PMASS,PVIRT | |
13879 | COMMON /POGCMS/ ECM,PCM,PMASS(2),PVIRT(2),IFPAP(2),IFPAB(2) | |
13880 | C obsolete cut-off information | |
13881 | DOUBLE PRECISION PTCUT,PTANO,FPS,FPH,PSOMIN,XSOMIN | |
13882 | COMMON /POCUT1/ PTCUT(4),PTANO(4),FPS(4),FPH(4),PSOMIN,XSOMIN | |
13883 | ||
13884 | DIMENSION XLDIF(2,50),XLMIN(2,50),REVP(2,50),POT(2,50) | |
13885 | ||
13886 | IF(IDEB(13).GE.10) THEN | |
13887 | WRITE(LO,'(1X,A)') 'PHO_SELSXR:' | |
13888 | WRITE(LO,'(5X,A,I4,5E11.3)') 'MSOFT,XS1,XS2,XMAX1,2', | |
13889 | & MSOFT,XS1,XS2,XMAX1,XMAX2 | |
13890 | DO 40 I=1,MSOFT | |
13891 | WRITE(LO,'(5X,A,I4,2E12.3)') 'EXPONENTS',I,XPOT1(I),XPOT2(I) | |
13892 | 40 CONTINUE | |
13893 | ENDIF | |
13894 | C | |
13895 | IREJ = 0 | |
13896 | C | |
13897 | XMINK = MAX(PSOMIN/ECM*2.D0,XSOMIN) | |
13898 | XMIN1 = MAX(AS/XMAX1,XMINK) | |
13899 | XMIN2 = MAX(AS/XMAX2,XMINK) | |
13900 | C | |
13901 | IF(MSOFT.EQ.1) THEN | |
13902 | XSOFT1(2) = 0.D0 | |
13903 | XSOFT2(2) = 0.D0 | |
13904 | RETURN | |
13905 | ENDIF | |
13906 | XWMAX = MAX(XMAX1**XPOT1(1),XMIN1**XPOT1(1)) | |
13907 | & *MAX(XMAX2**XPOT2(1),XMIN2**XPOT2(1)) | |
13908 | C | |
13909 | 10 CONTINUE | |
13910 | C | |
13911 | DO 50 I=2,MSOFT | |
13912 | POT(1,I) = XPOT1(I)+1.D0 | |
13913 | POT(2,I) = XPOT2(I)+1.D0 | |
13914 | REVP(1,I) = 1.D0/POT(1,I) | |
13915 | REVP(2,I) = 1.D0/POT(2,I) | |
13916 | XLMIN(1,I) = XMIN(1,I)**POT(1,I) | |
13917 | XLMAX = XMAX1**POT(1,I) | |
13918 | XLDIF(1,I) = XLMAX-XLMIN(1,I) | |
13919 | XLMIN(2,I) = XMIN(2,I)**POT(2,I) | |
13920 | XLMAX = XMAX2**POT(2,I) | |
13921 | XLDIF(2,I) = XLMAX-XLMIN(2,I) | |
13922 | 50 CONTINUE | |
13923 | C | |
13924 | ITRY0 = 0 | |
13925 | 5 CONTINUE | |
13926 | ITRY0 = ITRY0 + 1 | |
13927 | IF(ITRY0.GE.IPAMDL(181)) THEN | |
13928 | IF(MSOFT-MSMIN.GE.2) THEN | |
13929 | MSOFT = MSMIN | |
13930 | GOTO 10 | |
13931 | ENDIF | |
13932 | GOTO 1000 | |
13933 | ENDIF | |
13934 | XREST1 = 1.D0-XS1 | |
13935 | XREST2 = 1.D0-XS2 | |
13936 | DO 100 I=2,MSOFT | |
13937 | ITRY1 = 0 | |
13938 | ||
13939 | 20 CONTINUE | |
13940 | Z1 = XLDIF(1,I)*DT_RNDM(XS1)+XLMIN(1,I) | |
13941 | Z2 = XLDIF(2,I)*DT_RNDM(XS2)+XLMIN(2,I) | |
13942 | XSOFT1(I) = Z1**REVP(1,I) | |
13943 | XSOFT2(I) = Z2**REVP(2,I) | |
13944 | ITRY1 = ITRY1+1 | |
13945 | IF(ITRY1.GE.50) GOTO 1000 | |
13946 | IF( (XSOFT1(I)*XSOFT2(I)).LT.AS ) GOTO 20 | |
13947 | ||
13948 | XREST1 = XREST1-XSOFT1(I) | |
13949 | IF(XREST1.LT.XMIN1) GOTO 5 | |
13950 | IF(XREST1.LT.XMIN(1,1)) GOTO 5 | |
13951 | XREST2 = XREST2-XSOFT2(I) | |
13952 | IF(XREST2.LT.XMIN2) GOTO 5 | |
13953 | IF(XREST2.LT.XMIN(2,1)) GOTO 5 | |
13954 | IF(XREST1*XREST2.LT.AS) GOTO 5 | |
13955 | ||
13956 | 100 CONTINUE | |
13957 | XSOFT1(1) = XREST1 | |
13958 | XSOFT2(1) = XREST2 | |
13959 | IREJ=0 | |
13960 | * XX = 1.D0 | |
13961 | * DO 200 I=2,MSOFT | |
13962 | * XX = XX*XSOFT1(I)**XPOT1(I)*XSOFT2(I)**XPOT2(I) | |
13963 | *200 CONTINUE | |
13964 | XX = XSOFT1(1)**XPOT1(1)*XSOFT2(1)**XPOT2(1) | |
13965 | IF((XX-DT_RNDM(XX)*XWMAX).LT.0.D0) GOTO 5 | |
13966 | ||
13967 | XS1 = 1.D0-XREST1 | |
13968 | XS2 = 1.D0-XREST2 | |
13969 | RETURN | |
13970 | ||
13971 | 1000 CONTINUE | |
13972 | IREJ = 1 | |
13973 | IF(IDEB(13).GE.2) THEN | |
13974 | WRITE(LO,'(1X,A,2I4)') | |
13975 | & 'PHO_SELSXR: REJECTION(ITRY0/1)',ITRY0,ITRY1 | |
13976 | WRITE(LO,'(5X,A,3E12.3)') 'XMAX1,2,AS:',XMAX1,XMAX2,AS | |
13977 | ENDIF | |
13978 | ||
13979 | END | |
13980 | ||
13981 | *$ CREATE PHO_SELSX2.FOR | |
13982 | *COPY PHO_SELSX2 | |
13983 | CDECK ID>, PHO_SELSX2 | |
13984 | SUBROUTINE PHO_SELSX2(XPOT1,XPOT2,XMIN,XSUM1,XSUM2,XMAX1,XMAX2, | |
13985 | & XS1,XS2,IREJ) | |
13986 | C*********************************************************************** | |
13987 | C | |
13988 | C select x values of soft string ends using PHO_RNDBET | |
13989 | C | |
13990 | C*********************************************************************** | |
13991 | IMPLICIT DOUBLE PRECISION (A-H,O-Z) | |
13992 | SAVE | |
13993 | ||
13994 | DIMENSION XPOT1(*),XPOT2(*),XMIN(2,*),XS1(*),XS2(*) | |
13995 | ||
13996 | C input/output channels | |
13997 | INTEGER LI,LO | |
13998 | COMMON /POINOU/ LI,LO | |
13999 | C event debugging information | |
14000 | INTEGER NMAXD | |
14001 | PARAMETER (NMAXD=100) | |
14002 | INTEGER IDEB,KSPOM,KHPOM,KSREG,KHDIR,KACCEP,KSTRG,KHTRG,KSLOO, | |
14003 | & KHLOO,KSDPO,KHDPO,KEVENT,KSOFT,KHARD | |
14004 | COMMON /PODEBG/ IDEB(NMAXD),KSPOM,KHPOM,KSREG,KHDIR,KACCEP,KSTRG, | |
14005 | & KHTRG,KSLOO,KHLOO,KSDPO,KHDPO,KEVENT,KSOFT,KHARD | |
14006 | C model switches and parameters | |
14007 | CHARACTER*8 MDLNA | |
14008 | INTEGER ISWMDL,IPAMDL | |
14009 | DOUBLE PRECISION PARMDL | |
14010 | COMMON /POMDLS/ MDLNA(50),ISWMDL(50),PARMDL(400),IPAMDL(400) | |
14011 | C data on most recent hard scattering | |
14012 | INTEGER IA,IB,IC,ID,IV1,IV2,MSPR,IREJSC | |
14013 | DOUBLE PRECISION PTWANT,AS,AH,ALNS,ALNH,Z1MAX,Z1DIF,Z2MAX,Z2DIF, | |
14014 | & PT,PTfin,ETAC,ETAD,X1,X2,V,U,W,W1,AXX,QQPD,QQAL, | |
14015 | & PDF1,PDF2,WEIGHT,PHI1,PHI2,PHO1,PHO2 | |
14016 | COMMON /POCKIN/ PTWANT,AS,AH,ALNS,ALNH,Z1MAX,Z1DIF,Z2MAX,Z2DIF, | |
14017 | & PT,PTfin,ETAC,ETAD,X1,X2,V,U,W,W1,AXX, | |
14018 | & QQPD,QQAL,PDF1(-6:6),PDF2(-6:6),WEIGHT, | |
14019 | & PHI1(5),PHI2(5),PHO1(5),PHO2(5), | |
14020 | & IA,IB,IC,ID,IV1,IV2,MSPR,IREJSC | |
14021 | C obsolete cut-off information | |
14022 | DOUBLE PRECISION PTCUT,PTANO,FPS,FPH,PSOMIN,XSOMIN | |
14023 | COMMON /POCUT1/ PTCUT(4),PTANO(4),FPS(4),FPH(4),PSOMIN,XSOMIN | |
14024 | ||
14025 | IREJ = 0 | |
14026 | ||
14027 | IF(IDEB(32).GE.10) THEN | |
14028 | WRITE(LO,'(1X,A)') 'PHO_SELSX2:' | |
14029 | WRITE(LO,'(5X,A,5E11.3)') 'AS,XSUM1,2,XMAX1,2', | |
14030 | & AS,XSUM1,XSUM2,XMAX1,XMAX2 | |
14031 | DO 30 I=1,2 | |
14032 | WRITE(LO,'(5X,A,I4,2E12.3)') 'EXPONENTS',I,XPOT1(I),XPOT2(I) | |
14033 | 30 CONTINUE | |
14034 | ENDIF | |
14035 | ||
14036 | FAC1 = 1.D0-XSUM1 | |
14037 | FAC2 = 1.D0-XSUM2 | |
14038 | FAC = FAC1*FAC2 | |
14039 | GAM1 = XPOT1(1)+1.D0 | |
14040 | GAM2 = XPOT2(1)+1.D0 | |
14041 | BET1 = XPOT1(2)+1.D0 | |
14042 | BET2 = XPOT2(2)+1.D0 | |
14043 | ||
14044 | ITRY0 = 0 | |
14045 | DO 100 I=1,IPAMDL(182) | |
14046 | ||
14047 | ITRY1 = 0 | |
14048 | 10 CONTINUE | |
14049 | X1 = PHO_RNDBET(GAM1,BET1) | |
14050 | ITRY1 = ITRY1+1 | |
14051 | IF(ITRY1.GE.50) GOTO 1000 | |
14052 | IF((X1.LE.XMIN(1,1)).OR.((1.D0-X1).LE.XMIN(1,2))) GOTO 10 | |
14053 | ||
14054 | ITRY2 = 0 | |
14055 | 11 CONTINUE | |
14056 | X2 = PHO_RNDBET(GAM2,BET2) | |
14057 | ITRY2 = ITRY2+1 | |
14058 | IF(ITRY2.GE.50) GOTO 1000 | |
14059 | IF((X2.LE.XMIN(2,1)).OR.((1.D0-X2).LE.XMIN(2,2))) GOTO 11 | |
14060 | ||
14061 | X3 = 1.D0 - X1 | |
14062 | X4 = 1.D0 - X2 | |
14063 | IF(X1*X2*FAC.GT.AS) THEN | |
14064 | IF(X3*X4*FAC.GT.AS) THEN | |
14065 | XS1(1) = X1*FAC1 | |
14066 | XS1(2) = X3*FAC1 | |
14067 | XS2(1) = X2*FAC2 | |
14068 | XS2(2) = X4*FAC2 | |
14069 | IF(XS1(1).GT.XMIN(1,1)) THEN | |
14070 | IF(XS2(1).GT.XMIN(2,1)) THEN | |
14071 | IF(XS1(2).GT.XMIN(1,2)) THEN | |
14072 | IF(XS2(2).GT.XMIN(2,2)) THEN | |
14073 | XSUM1 = XSUM1+XS1(2) | |
14074 | XSUM2 = XSUM2+XS2(2) | |
14075 | GOTO 300 | |
14076 | ENDIF | |
14077 | ENDIF | |
14078 | ENDIF | |
14079 | ENDIF | |
14080 | ENDIF | |
14081 | ENDIF | |
14082 | ITRY0 = ITRY0+1 | |
14083 | ||
14084 | 100 CONTINUE | |
14085 | ||
14086 | 1000 CONTINUE | |
14087 | IREJ = 1 | |
14088 | IF(IDEB(32).GE.2) THEN | |
14089 | WRITE(LO,'(1X,A,3I4)') | |
14090 | & 'PHO_SELSX2: REJECTION(ITRY0/1/2)',ITRY0,ITRY1,ITRY2 | |
14091 | WRITE(LO,'(5X,A,3E12.3)') 'XMAX1,2,AS:',XMAX1,XMAX2,AS | |
14092 | ENDIF | |
14093 | RETURN | |
14094 | 300 CONTINUE | |
14095 | ||
14096 | END | |
14097 | ||
14098 | *$ CREATE PHO_SELSXS.FOR | |
14099 | *COPY PHO_SELSXS | |
14100 | CDECK ID>, PHO_SELSXS | |
14101 | SUBROUTINE PHO_SELSXS(MSOFT,MSMIN,XPOT1,XPOT2,XMIN,XS1,XS2, | |
14102 | & XMAX1,XMAX2,XSOFT1,XSOFT2,IREJ) | |
14103 | C*********************************************************************** | |
14104 | C | |
14105 | C select x values of soft string ends (rescaling method) | |
14106 | C | |
14107 | C*********************************************************************** | |
14108 | IMPLICIT DOUBLE PRECISION (A-H,O-Z) | |
14109 | SAVE | |
14110 | ||
14111 | DIMENSION XPOT1(*),XPOT2(*),XMIN(2,*),XSOFT1(*),XSOFT2(*) | |
14112 | ||
14113 | C input/output channels | |
14114 | INTEGER LI,LO | |
14115 | COMMON /POINOU/ LI,LO | |
14116 | C event debugging information | |
14117 | INTEGER NMAXD | |
14118 | PARAMETER (NMAXD=100) | |
14119 | INTEGER IDEB,KSPOM,KHPOM,KSREG,KHDIR,KACCEP,KSTRG,KHTRG,KSLOO, | |
14120 | & KHLOO,KSDPO,KHDPO,KEVENT,KSOFT,KHARD | |
14121 | COMMON /PODEBG/ IDEB(NMAXD),KSPOM,KHPOM,KSREG,KHDIR,KACCEP,KSTRG, | |
14122 | & KHTRG,KSLOO,KHLOO,KSDPO,KHDPO,KEVENT,KSOFT,KHARD | |
14123 | C model switches and parameters | |
14124 | CHARACTER*8 MDLNA | |
14125 | INTEGER ISWMDL,IPAMDL | |
14126 | DOUBLE PRECISION PARMDL | |
14127 | COMMON /POMDLS/ MDLNA(50),ISWMDL(50),PARMDL(400),IPAMDL(400) | |
14128 | C data on most recent hard scattering | |
14129 | INTEGER IA,IB,IC,ID,IV1,IV2,MSPR,IREJSC | |
14130 | DOUBLE PRECISION PTWANT,AS,AH,ALNS,ALNH,Z1MAX,Z1DIF,Z2MAX,Z2DIF, | |
14131 | & PT,PTfin,ETAC,ETAD,X1,X2,V,U,W,W1,AXX,QQPD,QQAL, | |
14132 | & PDF1,PDF2,WEIGHT,PHI1,PHI2,PHO1,PHO2 | |
14133 | COMMON /POCKIN/ PTWANT,AS,AH,ALNS,ALNH,Z1MAX,Z1DIF,Z2MAX,Z2DIF, | |
14134 | & PT,PTfin,ETAC,ETAD,X1,X2,V,U,W,W1,AXX, | |
14135 | & QQPD,QQAL,PDF1(-6:6),PDF2(-6:6),WEIGHT, | |
14136 | & PHI1(5),PHI2(5),PHO1(5),PHO2(5), | |
14137 | & IA,IB,IC,ID,IV1,IV2,MSPR,IREJSC | |
14138 | C obsolete cut-off information | |
14139 | DOUBLE PRECISION PTCUT,PTANO,FPS,FPH,PSOMIN,XSOMIN | |
14140 | COMMON /POCUT1/ PTCUT(4),PTANO(4),FPS(4),FPH(4),PSOMIN,XSOMIN | |
14141 | ||
14142 | DIMENSION XLDIF(2,50),XLMIN(2,50),REVP(2,50),POT(2,50) | |
14143 | ||
14144 | IREJ = 0 | |
14145 | ||
14146 | 10 CONTINUE | |
14147 | ||
14148 | IF(MSOFT.EQ.1) THEN | |
14149 | XSOFT1(1) = 1.D0-XS1 | |
14150 | XSOFT1(2) = 0.D0 | |
14151 | XSOFT2(1) = 1.D0-XS2 | |
14152 | XSOFT2(2) = 0.D0 | |
14153 | RETURN | |
14154 | ENDIF | |
14155 | ||
14156 | DO 50 I=1,MSOFT | |
14157 | POT(1,I) = XPOT1(I)+1.D0 | |
14158 | POT(2,I) = XPOT2(I)+1.D0 | |
14159 | REVP(1,I) = 1.D0/POT(1,I) | |
14160 | REVP(2,I) = 1.D0/POT(2,I) | |
14161 | XLMIN(1,I) = XMIN(1,I)**POT(1,I) | |
14162 | XLMAX = XMAX1**POT(1,I) | |
14163 | XLDIF(1,I) = XLMAX-XLMIN(1,I) | |
14164 | XLMIN(2,I) = XMIN(2,I)**POT(2,I) | |
14165 | XLMAX = XMAX2**POT(2,I) | |
14166 | XLDIF(2,I) = XLMAX-XLMIN(2,I) | |
14167 | 50 CONTINUE | |
14168 | ||
14169 | ITRY0 = 0 | |
14170 | 5 CONTINUE | |
14171 | ITRY0 = ITRY0 + 1 | |
14172 | IF(ITRY0.GE.IPAMDL(180)) THEN | |
14173 | IF(MSOFT-MSMIN.GE.2) THEN | |
14174 | MSOFT= MSMIN | |
14175 | GOTO 10 | |
14176 | ENDIF | |
14177 | GOTO 1000 | |
14178 | ENDIF | |
14179 | XSUM1 = 0.D0 | |
14180 | XSUM2 = 0.D0 | |
14181 | DO 100 I=1,MSOFT | |
14182 | ITRY1 = 0 | |
14183 | 20 CONTINUE | |
14184 | Z1 = XLDIF(1,I)*DT_RNDM(XS1)+XLMIN(1,I) | |
14185 | Z2 = XLDIF(2,I)*DT_RNDM(XS2)+XLMIN(2,I) | |
14186 | XSOFT1(I) = Z1**REVP(1,I) | |
14187 | XSOFT2(I) = Z2**REVP(2,I) | |
14188 | ITRY1 = ITRY1+1 | |
14189 | IF(ITRY1.GE.50) GOTO 1000 | |
14190 | IF( (XSOFT1(I)*XSOFT2(I)).LT.AS ) GOTO 20 | |
14191 | XSUM1 = XSUM1+XSOFT1(I) | |
14192 | XSUM2 = XSUM2+XSOFT2(I) | |
14193 | 100 CONTINUE | |
14194 | FAC1 = (1.D0-XS1)/XSUM1 | |
14195 | FAC2 = (1.D0-XS2)/XSUM2 | |
14196 | DO 200 I=1,MSOFT | |
14197 | XSOFT1(I) = XSOFT1(I)*FAC1 | |
14198 | XSOFT2(I) = XSOFT2(I)*FAC2 | |
14199 | IF(XSOFT1(I).LT.XMIN(1,I)) GOTO 5 | |
14200 | IF(XSOFT2(I).LT.XMIN(2,I)) GOTO 5 | |
14201 | IF(XSOFT1(I)*XSOFT2(I).LT.AS) GOTO 5 | |
14202 | 200 CONTINUE | |
14203 | ||
14204 | XS1 = 1.D0-XSOFT1(1) | |
14205 | XS2 = 1.D0-XSOFT2(1) | |
14206 | RETURN | |
14207 | ||
14208 | 1000 CONTINUE | |
14209 | IREJ = 1 | |
14210 | IF(IDEB(14).GE.2) THEN | |
14211 | WRITE(LO,'(1X,2A,3I4)') 'PHO_SELSXS: ', | |
14212 | & 'rejection (MSOFT,ITRY0/1)',MSOFT,ITRY0,ITRY1 | |
14213 | DO 300 I=1,MSOFT | |
14214 | WRITE(LO,'(5X,I4,1P4E11.3)') I,XMIN(1,I),XMIN(2,I),XMAX1,XMAX2 | |
14215 | 300 CONTINUE | |
14216 | ENDIF | |
14217 | ||
14218 | END | |
14219 | ||
14220 | *$ CREATE PHO_SELSXI.FOR | |
14221 | *COPY PHO_SELSXI | |
14222 | CDECK ID>, PHO_SELSXI | |
14223 | SUBROUTINE PHO_SELSXI(MSOFT,MSMIN,XPOT1,XPOT2,XMIN,XS1,XS2, | |
14224 | & XMAX1,XMAX2,XSOFT1,XSOFT2,IREJ) | |
14225 | C*********************************************************************** | |
14226 | C | |
14227 | C select x values of soft string ends (sea independent from valence) | |
14228 | C | |
14229 | C*********************************************************************** | |
14230 | IMPLICIT DOUBLE PRECISION (A-H,O-Z) | |
14231 | SAVE | |
14232 | ||
14233 | DIMENSION XPOT1(*),XPOT2(*),XMIN(2,*),XSOFT1(*),XSOFT2(*) | |
14234 | ||
14235 | C input/output channels | |
14236 | INTEGER LI,LO | |
14237 | COMMON /POINOU/ LI,LO | |
14238 | C event debugging information | |
14239 | INTEGER NMAXD | |
14240 | PARAMETER (NMAXD=100) | |
14241 | INTEGER IDEB,KSPOM,KHPOM,KSREG,KHDIR,KACCEP,KSTRG,KHTRG,KSLOO, | |
14242 | & KHLOO,KSDPO,KHDPO,KEVENT,KSOFT,KHARD | |
14243 | COMMON /PODEBG/ IDEB(NMAXD),KSPOM,KHPOM,KSREG,KHDIR,KACCEP,KSTRG, | |
14244 | & KHTRG,KSLOO,KHLOO,KSDPO,KHDPO,KEVENT,KSOFT,KHARD | |
14245 | C model switches and parameters | |
14246 | CHARACTER*8 MDLNA | |
14247 | INTEGER ISWMDL,IPAMDL | |
14248 | DOUBLE PRECISION PARMDL | |
14249 | COMMON /POMDLS/ MDLNA(50),ISWMDL(50),PARMDL(400),IPAMDL(400) | |
14250 | C data on most recent hard scattering | |
14251 | INTEGER IA,IB,IC,ID,IV1,IV2,MSPR,IREJSC | |
14252 | DOUBLE PRECISION PTWANT,AS,AH,ALNS,ALNH,Z1MAX,Z1DIF,Z2MAX,Z2DIF, | |
14253 | & PT,PTfin,ETAC,ETAD,X1,X2,V,U,W,W1,AXX,QQPD,QQAL, | |
14254 | & PDF1,PDF2,WEIGHT,PHI1,PHI2,PHO1,PHO2 | |
14255 | COMMON /POCKIN/ PTWANT,AS,AH,ALNS,ALNH,Z1MAX,Z1DIF,Z2MAX,Z2DIF, | |
14256 | & PT,PTfin,ETAC,ETAD,X1,X2,V,U,W,W1,AXX, | |
14257 | & QQPD,QQAL,PDF1(-6:6),PDF2(-6:6),WEIGHT, | |
14258 | & PHI1(5),PHI2(5),PHO1(5),PHO2(5), | |
14259 | & IA,IB,IC,ID,IV1,IV2,MSPR,IREJSC | |
14260 | C obsolete cut-off information | |
14261 | DOUBLE PRECISION PTCUT,PTANO,FPS,FPH,PSOMIN,XSOMIN | |
14262 | COMMON /POCUT1/ PTCUT(4),PTANO(4),FPS(4),FPH(4),PSOMIN,XSOMIN | |
14263 | ||
14264 | DIMENSION XLDIF(2,50),XLMIN(2,50),REVP(2,50),POT(2,50) | |
14265 | ||
14266 | IREJ = 0 | |
14267 | ||
14268 | 10 CONTINUE | |
14269 | ||
14270 | DO 50 I=1,MSOFT | |
14271 | POT(1,I) = XPOT1(I)+1.D0 | |
14272 | POT(2,I) = XPOT2(I)+1.D0 | |
14273 | REVP(1,I) = 1.D0/POT(1,I) | |
14274 | REVP(2,I) = 1.D0/POT(2,I) | |
14275 | XLMIN(1,I) = XMIN(1,I)**POT(1,I) | |
14276 | XLMAX = XMAX1**POT(1,I) | |
14277 | XLDIF(1,I) = XLMAX-XLMIN(1,I) | |
14278 | XLMIN(2,I) = XMIN(2,I)**POT(2,I) | |
14279 | XLMAX = XMAX2**POT(2,I) | |
14280 | XLDIF(2,I) = XLMAX-XLMIN(2,I) | |
14281 | 50 CONTINUE | |
14282 | ||
14283 | C selection of sea | |
14284 | ITRY0 = 0 | |
14285 | 5 CONTINUE | |
14286 | ||
14287 | ITRY0 = ITRY0 + 1 | |
14288 | IF(ITRY0.GE.IPAMDL(183)) THEN | |
14289 | IF(MSOFT-MSMIN.GE.2) THEN | |
14290 | MSOFT = MSMIN | |
14291 | GOTO 10 | |
14292 | ENDIF | |
14293 | GOTO 1000 | |
14294 | ENDIF | |
14295 | XSUM1 = XS1 | |
14296 | XSUM2 = XS2 | |
14297 | DO 100 I=3,MSOFT | |
14298 | ITRY1 = 0 | |
14299 | 20 CONTINUE | |
14300 | Z1 = XLDIF(1,I)*DT_RNDM(XS1)+XLMIN(1,I) | |
14301 | Z2 = XLDIF(2,I)*DT_RNDM(XS2)+XLMIN(2,I) | |
14302 | XSOFT1(I) = Z1**REVP(1,I) | |
14303 | XSOFT2(I) = Z2**REVP(2,I) | |
14304 | ITRY1 = ITRY1+1 | |
14305 | IF(ITRY1.GE.50) GOTO 1000 | |
14306 | IF( (XSOFT1(I)*XSOFT2(I)).LT.AS ) GOTO 20 | |
14307 | XSUM1 = XSUM1+XSOFT1(I) | |
14308 | XSUM2 = XSUM2+XSOFT2(I) | |
14309 | 100 CONTINUE | |
14310 | ||
14311 | IF(XSUM1.GT.1.D0-XMIN(1,1)-XMIN(1,2)) GOTO 5 | |
14312 | IF(XSUM2.GT.1.D0-XMIN(2,1)-XMIN(2,2)) GOTO 5 | |
14313 | ||
14314 | C selection of valence | |
14315 | CALL PHO_SELSX2(XPOT1,XPOT2,XMIN,XSUM1,XSUM2,XMAX1,XMAX2, | |
14316 | & XSOFT1,XSOFT2,IREJ) | |
14317 | IF(IREJ.NE.0) THEN | |
14318 | IF(MSOFT-MSMIN.GE.2) THEN | |
14319 | MSOFT = MSMIN | |
14320 | GOTO 10 | |
14321 | ENDIF | |
14322 | IF(IDEB(31).GE.2) WRITE(LO,'(1X,A,1P,4E11.4)') | |
14323 | & 'PHO_SELSXI: rejection by PHO_SELSX2 (XSUM1/2,XMAX1/2)', | |
14324 | & XSUM1,XSUM2,XMAX1,XMAX2 | |
14325 | RETURN | |
14326 | ENDIF | |
14327 | ||
14328 | XS1 = 1.D0-XSOFT1(1) | |
14329 | XS2 = 1.D0-XSOFT2(1) | |
14330 | RETURN | |
14331 | ||
14332 | 1000 CONTINUE | |
14333 | IREJ = 1 | |
14334 | IF(IDEB(14).GE.2) THEN | |
14335 | WRITE(LO,'(1X,2A,3I4)') 'PHO_SELSXI: ', | |
14336 | & 'rejection (MSOFT,ITRY0/1)',MSOFT,ITRY0,ITRY1 | |
14337 | DO 300 I=1,MSOFT | |
14338 | WRITE(LO,'(5X,I4,1P4E11.3)') I,XMIN(1,I),XMIN(2,I),XMAX1,XMAX2 | |
14339 | 300 CONTINUE | |
14340 | ENDIF | |
14341 | ||
14342 | END | |
14343 | ||
14344 | *$ CREATE PHO_SELCOL.FOR | |
14345 | *COPY PHO_SELCOL | |
14346 | CDECK ID>, PHO_SELCOL | |
14347 | SUBROUTINE PHO_SELCOL(ICO1,ICO2,ICOA1,ICOA2,ICOB1,ICOB2,IMODE) | |
14348 | C******************************************************************** | |
14349 | C | |
14350 | C color combinatorics | |
14351 | C | |
14352 | C input: ICO1,2 colors of incoming particle | |
14353 | C IMODE -2 output of initialization status | |
14354 | C -1 initialization | |
14355 | C ICINP(1) selection mode | |
14356 | C 0 QCD | |
14357 | C 1 large N_c expansion | |
14358 | C ICINP(2) max. allowed color | |
14359 | C 0 clear internal color counter | |
14360 | C 1 hadron into two colored objects | |
14361 | C 2 quark into quark gluon | |
14362 | C 3 gluon into gluon gluon | |
14363 | C 4 gluon into quark antiquark | |
14364 | C | |
14365 | C output: ICOA1,2 colors of first outgoing particle | |
14366 | C ICOB1,2 colors of second outgoing particle | |
14367 | C | |
14368 | C******************************************************************** | |
14369 | IMPLICIT DOUBLE PRECISION (A-H,O-Z) | |
14370 | SAVE | |
14371 | ||
14372 | C input/output channels | |
14373 | INTEGER LI,LO | |
14374 | COMMON /POINOU/ LI,LO | |
14375 | C event debugging information | |
14376 | INTEGER NMAXD | |
14377 | PARAMETER (NMAXD=100) | |
14378 | INTEGER IDEB,KSPOM,KHPOM,KSREG,KHDIR,KACCEP,KSTRG,KHTRG,KSLOO, | |
14379 | & KHLOO,KSDPO,KHDPO,KEVENT,KSOFT,KHARD | |
14380 | COMMON /PODEBG/ IDEB(NMAXD),KSPOM,KHPOM,KSREG,KHDIR,KACCEP,KSTRG, | |
14381 | & KHTRG,KSLOO,KHLOO,KSDPO,KHDPO,KEVENT,KSOFT,KHARD | |
14382 | ||
14383 | DATA METHOD /0/, II /0/ | |
14384 | ||
14385 | ICI1 = ICO1 | |
14386 | ICI2 = ICO2 | |
14387 | IF(METHOD.EQ.0) THEN | |
14388 | ||
14389 | IF(IMODE.EQ.1) THEN | |
14390 | II = II+1 | |
14391 | IF(II.GT.MAXCOL) | |
14392 | & II = MIN(DT_RNDM(DUM)*MAXCOL+1.00001,DBLE(MAXCOL)) | |
14393 | ICOA1 = II | |
14394 | ICOA2 = 0 | |
14395 | ICOB1 = -II | |
14396 | ICOB2 = 0 | |
14397 | ELSE IF(IMODE.EQ.2) THEN | |
14398 | II = II+1 | |
14399 | IF(II.GT.MAXCOL) | |
14400 | & II = MIN(DT_RNDM(DUM)*MAXCOL+1.00001,DBLE(MAXCOL)) | |
14401 | ICOA2 = 0 | |
14402 | IF(ICI1.GT.0) THEN | |
14403 | ICOA1 = II | |
14404 | ICOB1 = ICI1 | |
14405 | ICOB2 = -II | |
14406 | ELSE | |
14407 | ICOA1 = -II | |
14408 | ICOB1 = II | |
14409 | ICOB2 = ICI1 | |
14410 | ENDIF | |
14411 | ELSE IF(IMODE.EQ.3) THEN | |
14412 | II = II+1 | |
14413 | IF(II.GT.MAXCOL) | |
14414 | & II = MIN(DT_RNDM(DUM)*MAXCOL+1.00001,DBLE(MAXCOL)) | |
14415 | IF(DT_RNDM(DUM).GT.0.5D0) THEN | |
14416 | ICOA1 = ICI1 | |
14417 | ICOA2 = -II | |
14418 | ICOB1 = II | |
14419 | ICOB2 = ICI2 | |
14420 | ELSE | |
14421 | ICOB1 = ICI1 | |
14422 | ICOB2 = -II | |
14423 | ICOA1 = II | |
14424 | ICOA2 = ICI2 | |
14425 | ENDIF | |
14426 | ELSE IF(IMODE.EQ.4) THEN | |
14427 | ICOA1 = ICI1 | |
14428 | ICOA2 = 0 | |
14429 | ICOB1 = ICI2 | |
14430 | ICOB2 = 0 | |
14431 | ELSE IF(IMODE.EQ.0) THEN | |
14432 | II = 0 | |
14433 | ELSE IF(IMODE.EQ.-1) THEN | |
14434 | METHOD = ICI1 | |
14435 | MAXCOL = ICI2 | |
14436 | ELSE IF(IMODE.EQ.-2) THEN | |
14437 | WRITE(LO,'(1X,A,2I5)') 'PHO_SELCOL: METHOD,MAXCOL', | |
14438 | & METHOD,MAXCOL | |
14439 | ELSE | |
14440 | WRITE(LO,'(1X,A,I5)') | |
14441 | & 'PHO_SELCOL:ERROR: unsupported mode',IMODE | |
14442 | CALL PHO_ABORT | |
14443 | ENDIF | |
14444 | ||
14445 | ELSE | |
14446 | WRITE(LO,'(1X,A,I5)') | |
14447 | & 'PHO_SELCOL:ERROR:unsupported method selected',METHOD | |
14448 | CALL PHO_ABORT | |
14449 | ENDIF | |
14450 | ||
14451 | II = ABS(II) | |
14452 | IF(IDEB(75).GE.10) THEN | |
14453 | WRITE(LO,'(1X,A,I5,I12,I5)') 'PHO_SELCOL: IMODE,MAXCOL,II', | |
14454 | & IMODE,MAXCOL,II | |
14455 | WRITE(LO,'(10X,A,2I5)') 'input colors',ICI1,ICI2 | |
14456 | WRITE(LO,'(10X,A,4I5)') 'output colors',ICOA1,ICOA2,ICOB1,ICOB2 | |
14457 | ENDIF | |
14458 | ||
14459 | END | |
14460 | ||
14461 | *$ CREATE ipho_diqu.FOR | |
14462 | *COPY ipho_diqu | |
14463 | CDECK ID>, ipho_diqu | |
14464 | INTEGER FUNCTION ipho_diqu(iq1,iq2) | |
14465 | C*********************************************************************** | |
14466 | C | |
14467 | C selection of diquark number (PDG convention) | |
14468 | C | |
14469 | C*********************************************************************** | |
14470 | IMPLICIT NONE | |
14471 | SAVE | |
14472 | ||
14473 | integer iq1,iq2 | |
14474 | ||
14475 | C input/output channels | |
14476 | INTEGER LI,LO | |
14477 | COMMON /POINOU/ LI,LO | |
14478 | C event debugging information | |
14479 | INTEGER NMAXD | |
14480 | PARAMETER (NMAXD=100) | |
14481 | INTEGER IDEB,KSPOM,KHPOM,KSREG,KHDIR,KACCEP,KSTRG,KHTRG,KSLOO, | |
14482 | & KHLOO,KSDPO,KHDPO,KEVENT,KSOFT,KHARD | |
14483 | COMMON /PODEBG/ IDEB(NMAXD),KSPOM,KHPOM,KSREG,KHDIR,KACCEP,KSTRG, | |
14484 | & KHTRG,KSLOO,KHLOO,KSDPO,KHDPO,KEVENT,KSOFT,KHARD | |
14485 | C model switches and parameters | |
14486 | CHARACTER*8 MDLNA | |
14487 | INTEGER ISWMDL,IPAMDL | |
14488 | DOUBLE PRECISION PARMDL | |
14489 | COMMON /POMDLS/ MDLNA(50),ISWMDL(50),PARMDL(400),IPAMDL(400) | |
14490 | ||
14491 | C external functions | |
14492 | double precision DT_RNDM | |
14493 | ||
14494 | C local variables | |
14495 | integer i0,i1,i2 | |
14496 | double precision dum | |
14497 | ||
14498 | i1 = abs(iq1) | |
14499 | i2 = abs(iq2) | |
14500 | ||
14501 | if(i1.eq.i2) then | |
14502 | i0 = i1*1100+3 | |
14503 | else | |
14504 | i0 = max(i1,i2)*1000+min(i1,i2)*100 | |
14505 | if(DT_RNDM(dum).gt.PARMDL(135)) then | |
14506 | i0 = i0+1 | |
14507 | else | |
14508 | i0 = i0+3 | |
14509 | endif | |
14510 | endif | |
14511 | ||
14512 | ipho_diqu = sign(i0,iq1) | |
14513 | ||
14514 | END | |
14515 | ||
14516 | *$ CREATE PHO_PARREM.FOR | |
14517 | *COPY PHO_PARREM | |
14518 | CDECK ID>, PHO_PARREM | |
14519 | SUBROUTINE PHO_PARREM(INDX,IOUT,IREM,IREJ) | |
14520 | C********************************************************************** | |
14521 | C | |
14522 | C selection of particle remnant flavour(s) (quark or diquark) | |
14523 | C | |
14524 | C input: INDX index of particle in /POEVT1/ | |
14525 | C IOUT parton which was taken out | |
14526 | C | |
14527 | C output: IREM remnant according to valence flavours | |
14528 | C IREJ 0 flavour combination possible | |
14529 | C 1 flavour combination impossible | |
14530 | C | |
14531 | C all particle ID are given according to PDG conventions | |
14532 | C | |
14533 | C********************************************************************** | |
14534 | IMPLICIT NONE | |
14535 | SAVE | |
14536 | ||
14537 | integer INDX,IOUT,IREM,IREJ | |
14538 | ||
14539 | C input/output channels | |
14540 | INTEGER LI,LO | |
14541 | COMMON /POINOU/ LI,LO | |
14542 | C event debugging information | |
14543 | INTEGER NMAXD | |
14544 | PARAMETER (NMAXD=100) | |
14545 | INTEGER IDEB,KSPOM,KHPOM,KSREG,KHDIR,KACCEP,KSTRG,KHTRG,KSLOO, | |
14546 | & KHLOO,KSDPO,KHDPO,KEVENT,KSOFT,KHARD | |
14547 | COMMON /PODEBG/ IDEB(NMAXD),KSPOM,KHPOM,KSREG,KHDIR,KACCEP,KSTRG, | |
14548 | & KHTRG,KSLOO,KHLOO,KSDPO,KHDPO,KEVENT,KSOFT,KHARD | |
14549 | C standard particle data interface | |
14550 | INTEGER NMXHEP | |
14551 | PARAMETER (NMXHEP=4000) | |
14552 | INTEGER NEVHEP,NHEP,ISTHEP,IDHEP,JMOHEP,JDAHEP | |
14553 | DOUBLE PRECISION PHEP,VHEP | |
14554 | COMMON /POEVT1/ NEVHEP,NHEP,ISTHEP(NMXHEP),IDHEP(NMXHEP), | |
14555 | & JMOHEP(2,NMXHEP),JDAHEP(2,NMXHEP),PHEP(5,NMXHEP), | |
14556 | & VHEP(4,NMXHEP) | |
14557 | C extension to standard particle data interface (PHOJET specific) | |
14558 | INTEGER IMPART,IPHIST,ICOLOR | |
14559 | COMMON /POEVT2/ IMPART(NMXHEP),IPHIST(2,NMXHEP),ICOLOR(2,NMXHEP) | |
14560 | C general particle data | |
14561 | double precision xm_list,tau_list,gam_list, | |
14562 | & xm_psm2_list,xm_vem2_list,xm_b82_list,xm_b102_list, | |
14563 | & xm_bb82_list,xm_bb102_list | |
14564 | integer ich3_list,iba3_list,iq_list, | |
14565 | & id_psm_list,id_vem_list,id_b8_list,id_b10_list | |
14566 | COMMON /POPAR2/ xm_list(300),tau_list(300),gam_list(300), | |
14567 | & xm_psm2_list(6,6),xm_vem2_list(6,6), | |
14568 | & xm_b82_list(6,6,6),xm_b102_list(6,6,6), | |
14569 | & xm_bb82_list(6,6,6,6),xm_bb102_list(6,6,6,6), | |
14570 | & ich3_list(300),iba3_list(300),iq_list(3,300), | |
14571 | & id_psm_list(6,6),id_vem_list(6,6), | |
14572 | & id_b8_list(6,6,6),id_b10_list(6,6,6) | |
14573 | ||
14574 | C external functions | |
14575 | integer ipho_diqu | |
14576 | ||
14577 | C local variables | |
14578 | integer ID,IS,ID1,ID2,i,k,K1,K2,IQUA,IDQ | |
14579 | dimension IQUA(3),IDQ(2) | |
14580 | ||
14581 | ID1 = IDHEP(INDX) | |
14582 | ID2 = IMPART(INDX) | |
14583 | IREJ = 0 | |
14584 | ||
14585 | IF(ID2.EQ.0) THEN | |
14586 | WRITE(LO,'(1X,A,I6)') 'PHO_PARREM: no CPC ID available for',INDX | |
14587 | CALL PHO_ABORT | |
14588 | ENDIF | |
14589 | ||
14590 | C particle with flavour mixing | |
14591 | if(ID1.eq.22) then | |
14592 | C photon | |
14593 | IREM = -IOUT | |
14594 | GOTO 100 | |
14595 | else if((ID1.eq.111).or.(ID1.eq.113).or.(ID1.eq.223)) then | |
14596 | C pi0, rho0, and omega | |
14597 | IF(ABS(IOUT).LE.2) THEN | |
14598 | IREM = -IOUT | |
14599 | GOTO 100 | |
14600 | ELSE | |
14601 | GOTO 150 | |
14602 | ENDIF | |
14603 | else if((abs(ID1).eq.311).or.(ID1.eq.310).or.(ID1.eq.130)) then | |
14604 | C neutral kaons (K0,K0-bar) | |
14605 | if(abs(IOUT).eq.1) then | |
14606 | IREM = sign(3,-IOUT) | |
14607 | goto 100 | |
14608 | else if(abs(IOUT).eq.3) then | |
14609 | IREM = sign(1,-IOUT) | |
14610 | goto 100 | |
14611 | else | |
14612 | goto 150 | |
14613 | endif | |
14614 | else if((ID1.eq.990).or.(ID1.eq.110)) then | |
14615 | C pomeron and reggeon | |
14616 | IREM = -IOUT | |
14617 | GOTO 100 | |
14618 | endif | |
14619 | ||
14620 | C ordinary hadron | |
14621 | ID = abs(ID2) | |
14622 | IS = sign(1,ID2) | |
14623 | IQUA(1) = iq_list(1,ID)*IS | |
14624 | IQUA(2) = iq_list(2,ID)*IS | |
14625 | IQUA(3) = iq_list(3,ID)*IS | |
14626 | ||
14627 | C compare to flavour content | |
14628 | IF(ABS(IOUT).LT.1000) THEN | |
14629 | C single quark requested | |
14630 | IF(IQUA(1).EQ.IOUT) THEN | |
14631 | K1 = 2 | |
14632 | K2 = 3 | |
14633 | ELSE IF(IQUA(2).EQ.IOUT) THEN | |
14634 | K1 = 1 | |
14635 | K2 = 3 | |
14636 | ELSE IF(IQUA(3).EQ.IOUT) THEN | |
14637 | K1 = 1 | |
14638 | K2 = 2 | |
14639 | ELSE | |
14640 | GOTO 150 | |
14641 | ENDIF | |
14642 | IF(IQUA(3).EQ.0) THEN | |
14643 | IREM = IQUA(K1) | |
14644 | ELSE | |
14645 | IREM = ipho_diqu(IQUA(K1),IQUA(K2)) | |
14646 | ENDIF | |
14647 | ELSE IF(IQUA(3).NE.0) THEN | |
14648 | C diquark requested from baryon | |
14649 | IDQ(1) = IOUT/1000 | |
14650 | IDQ(2) = (IOUT-IDQ(1)*1000)/100 | |
14651 | do i=1,2 | |
14652 | do k=1,3 | |
14653 | if(IDQ(i).eq.IQUA(k)) then | |
14654 | IQUA(k) = 0 | |
14655 | goto 110 | |
14656 | endif | |
14657 | enddo | |
14658 | goto 150 | |
14659 | 110 continue | |
14660 | enddo | |
14661 | IREM = IQUA(1)+IQUA(2)+IQUA(3) | |
14662 | ENDIF | |
14663 | ||
14664 | 100 CONTINUE | |
14665 | C debug output | |
14666 | IF(IDEB(72).GE.10) WRITE(LO,'(1X,A,5I6)') | |
14667 | & 'PHO_PARREM: INDX,ID-PDG,ID-BAM,IOUT,IREM', | |
14668 | & INDX,ID1,ID2,IOUT,IREM | |
14669 | RETURN | |
14670 | ||
14671 | C rejection | |
14672 | 150 CONTINUE | |
14673 | IREJ = 1 | |
14674 | IF(IDEB(72).GE.2) WRITE(LO,'(1X,A,5I7)') | |
14675 | & 'PHO_PARREM: rejection IDPDG,Q1-3,IOUT',IDHEP(INDX),IQUA,IOUT | |
14676 | ||
14677 | END | |
14678 | ||
14679 | *$ CREATE PHO_VALFLA.FOR | |
14680 | *COPY PHO_VALFLA | |
14681 | CDECK ID>, PHO_VALFLA | |
14682 | SUBROUTINE PHO_VALFLA(IPAR,IFL1,IFL2,E1,E2) | |
14683 | C*********************************************************************** | |
14684 | C | |
14685 | C selection of valence flavour decomposition of particle IPAR | |
14686 | C | |
14687 | C input: IPAR particle index in /POEVT1/ | |
14688 | C -1 initialization | |
14689 | C -2 output of statistics | |
14690 | C XMASS mass of particle | |
14691 | C (important for pomeron: | |
14692 | C mass dependent flavour sampling) | |
14693 | C | |
14694 | C output: IFL1,IFL2 | |
14695 | C baryon: IFL1 diquark flavour | |
14696 | C (valence flavours according to PDG conventions) | |
14697 | C | |
14698 | C*********************************************************************** | |
14699 | IMPLICIT DOUBLE PRECISION (A-H,O-Z) | |
14700 | SAVE | |
14701 | ||
14702 | PARAMETER ( EPS = 0.1D0, | |
14703 | & DEPS = 1.D-15) | |
14704 | ||
14705 | C input/output channels | |
14706 | INTEGER LI,LO | |
14707 | COMMON /POINOU/ LI,LO | |
14708 | C event debugging information | |
14709 | INTEGER NMAXD | |
14710 | PARAMETER (NMAXD=100) | |
14711 | INTEGER IDEB,KSPOM,KHPOM,KSREG,KHDIR,KACCEP,KSTRG,KHTRG,KSLOO, | |
14712 | & KHLOO,KSDPO,KHDPO,KEVENT,KSOFT,KHARD | |
14713 | COMMON /PODEBG/ IDEB(NMAXD),KSPOM,KHPOM,KSREG,KHDIR,KACCEP,KSTRG, | |
14714 | & KHTRG,KSLOO,KHLOO,KSDPO,KHDPO,KEVENT,KSOFT,KHARD | |
14715 | C model switches and parameters | |
14716 | CHARACTER*8 MDLNA | |
14717 | INTEGER ISWMDL,IPAMDL | |
14718 | DOUBLE PRECISION PARMDL | |
14719 | COMMON /POMDLS/ MDLNA(50),ISWMDL(50),PARMDL(400),IPAMDL(400) | |
14720 | C standard particle data interface | |
14721 | INTEGER NMXHEP | |
14722 | PARAMETER (NMXHEP=4000) | |
14723 | INTEGER NEVHEP,NHEP,ISTHEP,IDHEP,JMOHEP,JDAHEP | |
14724 | DOUBLE PRECISION PHEP,VHEP | |
14725 | COMMON /POEVT1/ NEVHEP,NHEP,ISTHEP(NMXHEP),IDHEP(NMXHEP), | |
14726 | & JMOHEP(2,NMXHEP),JDAHEP(2,NMXHEP),PHEP(5,NMXHEP), | |
14727 | & VHEP(4,NMXHEP) | |
14728 | C extension to standard particle data interface (PHOJET specific) | |
14729 | INTEGER IMPART,IPHIST,ICOLOR | |
14730 | COMMON /POEVT2/ IMPART(NMXHEP),IPHIST(2,NMXHEP),ICOLOR(2,NMXHEP) | |
14731 | C general particle data | |
14732 | double precision xm_list,tau_list,gam_list, | |
14733 | & xm_psm2_list,xm_vem2_list,xm_b82_list,xm_b102_list, | |
14734 | & xm_bb82_list,xm_bb102_list | |
14735 | integer ich3_list,iba3_list,iq_list, | |
14736 | & id_psm_list,id_vem_list,id_b8_list,id_b10_list | |
14737 | COMMON /POPAR2/ xm_list(300),tau_list(300),gam_list(300), | |
14738 | & xm_psm2_list(6,6),xm_vem2_list(6,6), | |
14739 | & xm_b82_list(6,6,6),xm_b102_list(6,6,6), | |
14740 | & xm_bb82_list(6,6,6,6),xm_bb102_list(6,6,6,6), | |
14741 | & ich3_list(300),iba3_list(300),iq_list(3,300), | |
14742 | & id_psm_list(6,6),id_vem_list(6,6), | |
14743 | & id_b8_list(6,6,6),id_b10_list(6,6,6) | |
14744 | ||
14745 | data ITMX / 5 / | |
14746 | ||
14747 | IF(IPAR.GT.0) THEN | |
14748 | K = IPAR | |
14749 | C select particle code | |
14750 | ID1 = IDHEP(K) | |
14751 | ID = abs(IMPART(K)) | |
14752 | IBAR = IPHO_BAR3(K,2) | |
14753 | ITER = 0 | |
14754 | ||
14755 | 10 CONTINUE | |
14756 | ||
14757 | ifl1 = 0 | |
14758 | ifl2 = 0 | |
14759 | ITER = ITER+1 | |
14760 | if(ITER.GT.ITMX) then | |
14761 | WRITE(LO,'(1x,2a,i10,1p,2e11.3)') 'PHO_VALFLA: ', | |
14762 | & 'no valences found for (IPAR,E1,E2)',IPAR,E1,E2 | |
14763 | return | |
14764 | endif | |
14765 | ||
14766 | C not baryon | |
14767 | IF(IBAR.EQ.0) THEN | |
14768 | ||
14769 | C photon | |
14770 | IF(ID1.EQ.22) THEN | |
14771 | C charge dependent flavour sampling | |
14772 | 15 CONTINUE | |
14773 | K = INT(DT_RNDM(E1)*6.D0)+1 | |
14774 | IF(K.LE.4) THEN | |
14775 | IFL1 = 2 | |
14776 | IFL2 = -2 | |
14777 | ELSE IF(K.EQ.5) THEN | |
14778 | IFL1 = 1 | |
14779 | IFL2 = -1 | |
14780 | ELSE | |
14781 | IFL1 = 3 | |
14782 | IFL2 = -3 | |
14783 | ENDIF | |
14784 | C optional strangeness suppression | |
14785 | IF((IFL1.EQ.3).AND.(DT_RNDM(E2).GT.PARMDL(160))) GOTO 15 | |
14786 | IF(DT_RNDM(DUM).LT.0.5D0) THEN | |
14787 | K = IFL1 | |
14788 | IFL1 = IFL2 | |
14789 | IFL2 = K | |
14790 | ENDIF | |
14791 | ||
14792 | C pomeron, reggeon | |
14793 | ELSE IF((ID1.EQ.990).or.(ID1.eq.110)) THEN | |
14794 | IF(ISWMDL(19).EQ.0) THEN | |
14795 | C SU(3) symmetric valences | |
14796 | K = INT(DT_RNDM(E1)*3.D0)+1 | |
14797 | IF(DT_RNDM(DUM).LT.0.5D0) THEN | |
14798 | IFL1 = K | |
14799 | ELSE | |
14800 | IFL1 = -K | |
14801 | ENDIF | |
14802 | IFL2 = -IFL1 | |
14803 | ELSE IF(ISWMDL(19).EQ.1) THEN | |
14804 | C mass dependent flavour sampling | |
14805 | EMIN = MIN(E1,E2) | |
14806 | CALL PHO_SEAFLA(IPAR,IFL1,IFL2,EMIN) | |
14807 | ELSE | |
14808 | WRITE(LO,'(/1X,2A,I5)') 'PHO_VALFLA: ', | |
14809 | & 'invalid flavour selection mode ISWMDL(19)',ISWMDL(19) | |
14810 | CALL PHO_ABORT | |
14811 | ENDIF | |
14812 | ||
14813 | C meson with flavour mixing | |
14814 | ELSE if((ID1.eq.111).or.(ID1.eq.113).or.(ID1.eq.223)) then | |
14815 | K = INT(2.D0*DT_RNDM(E1))+1 | |
14816 | IFL1 = K | |
14817 | IFL2 = -K | |
14818 | C meson (standard) | |
14819 | ELSE | |
14820 | K = INT(2.D0*DT_RNDM(E1))+1 | |
14821 | IFL1 = iq_list(K,ID) | |
14822 | K = MOD(K,2) + 1 | |
14823 | IFL2 = iq_list(K,ID) | |
14824 | if(IFL1.EQ.0) then | |
14825 | EMIN = MIN(E1,E2) | |
14826 | CALL PHO_SEAFLA(IPAR,IFL1,IFL2,EMIN) | |
14827 | endif | |
14828 | ENDIF | |
14829 | ||
14830 | C baryon | |
14831 | ELSE | |
14832 | K = INT(2.999999D0*DT_RNDM(E2))+1 | |
14833 | K1 = MOD(K,3)+1 | |
14834 | K2 = MOD(K1,3)+1 | |
14835 | IFL1 = ipho_diqu(iq_list(K1,ID),iq_list(K2,ID)) | |
14836 | IFL2 = iq_list(K,ID) | |
14837 | ENDIF | |
14838 | ||
14839 | C change sign for antiparticles | |
14840 | if(ID1.lt.0) then | |
14841 | IFL1 = -IFL1 | |
14842 | IFL2 = -IFL2 | |
14843 | endif | |
14844 | ||
14845 | ************************************************************************ | |
14846 | C check kinematic constraints | |
14847 | * IF((PHO_PMASS(IFL1,3).GT.E1) | |
14848 | * & .OR.(PHO_PMASS(IFL2,3).GT.E2)) GOTO 10 | |
14849 | ************************************************************************ | |
14850 | ||
14851 | C debug output | |
14852 | IF(IDEB(46).GE.10) WRITE(LO,'(1X,A,I5,2E12.4,2I7)') | |
14853 | & 'PHO_VALFLA: IPAR,MASS1/2,FL1/2',IPAR,E1,E2,IFL1,IFL2 | |
14854 | ||
14855 | ELSE IF(IPAR.EQ.-1) THEN | |
14856 | C initialization | |
14857 | ||
14858 | ELSE IF(IPAR.EQ.-2) THEN | |
14859 | C output of final statistics | |
14860 | ||
14861 | ELSE | |
14862 | WRITE(LO,'(1X,A,I10)') | |
14863 | & 'PHO_VALFLA:ERROR: invalid input particle (IPAR)',IPAR | |
14864 | CALL PHO_ABORT | |
14865 | ENDIF | |
14866 | ||
14867 | END | |
14868 | ||
14869 | *$ CREATE PHO_REGFLA.FOR | |
14870 | *COPY PHO_REGFLA | |
14871 | CDECK ID>, PHO_REGFLA | |
14872 | SUBROUTINE PHO_REGFLA(JM1,JM2,IFLR1,IFLR2,IREJ) | |
14873 | C********************************************************************** | |
14874 | C | |
14875 | C selection of reggeon flavours | |
14876 | C | |
14877 | C input: JM1,JM2 position index of mother hadrons | |
14878 | C | |
14879 | C output: IFLR1,IFLR2 valence flavours according to | |
14880 | C PDG conventions and JM1,JM2 | |
14881 | C IREJ 0 reggeon possible | |
14882 | C 1 reggeon impossible | |
14883 | C | |
14884 | C********************************************************************** | |
14885 | IMPLICIT DOUBLE PRECISION (A-H,O-Z) | |
14886 | SAVE | |
14887 | ||
14888 | PARAMETER ( EPS = 0.1D0, | |
14889 | & DEPS = 1.D-15) | |
14890 | ||
14891 | C input/output channels | |
14892 | INTEGER LI,LO | |
14893 | COMMON /POINOU/ LI,LO | |
14894 | C event debugging information | |
14895 | INTEGER NMAXD | |
14896 | PARAMETER (NMAXD=100) | |
14897 | INTEGER IDEB,KSPOM,KHPOM,KSREG,KHDIR,KACCEP,KSTRG,KHTRG,KSLOO, | |
14898 | & KHLOO,KSDPO,KHDPO,KEVENT,KSOFT,KHARD | |
14899 | COMMON /PODEBG/ IDEB(NMAXD),KSPOM,KHPOM,KSREG,KHDIR,KACCEP,KSTRG, | |
14900 | & KHTRG,KSLOO,KHLOO,KSDPO,KHDPO,KEVENT,KSOFT,KHARD | |
14901 | C nucleon-nucleus / nucleus-nucleus interface to DPMJET | |
14902 | INTEGER IDEQP,IDEQB,IHFLD,IHFLS | |
14903 | DOUBLE PRECISION ECMN,PCMN,SECM,SPCM,XPSUB,XTSUB | |
14904 | COMMON /POHDFL/ ECMN,PCMN,SECM,SPCM,XPSUB,XTSUB, | |
14905 | & IDEQP(2),IDEQB(2),IHFLD(2,2),IHFLS(2) | |
14906 | C standard particle data interface | |
14907 | INTEGER NMXHEP | |
14908 | PARAMETER (NMXHEP=4000) | |
14909 | INTEGER NEVHEP,NHEP,ISTHEP,IDHEP,JMOHEP,JDAHEP | |
14910 | DOUBLE PRECISION PHEP,VHEP | |
14911 | COMMON /POEVT1/ NEVHEP,NHEP,ISTHEP(NMXHEP),IDHEP(NMXHEP), | |
14912 | & JMOHEP(2,NMXHEP),JDAHEP(2,NMXHEP),PHEP(5,NMXHEP), | |
14913 | & VHEP(4,NMXHEP) | |
14914 | C extension to standard particle data interface (PHOJET specific) | |
14915 | INTEGER IMPART,IPHIST,ICOLOR | |
14916 | COMMON /POEVT2/ IMPART(NMXHEP),IPHIST(2,NMXHEP),ICOLOR(2,NMXHEP) | |
14917 | ||
14918 | IF(JM1.GT.0) THEN | |
14919 | IREJ = 0 | |
14920 | ITER = 0 | |
14921 | C available energy | |
14922 | E1 = SQRT((PHEP(4,JM1)+PHEP(4,JM2))**2 | |
14923 | & -(PHEP(1,JM1)+PHEP(1,JM2))**2 | |
14924 | & -(PHEP(2,JM1)+PHEP(2,JM2))**2 | |
14925 | & -(PHEP(3,JM1)+PHEP(3,JM2))**2)/2.D0 | |
14926 | 50 CONTINUE | |
14927 | ITER = ITER+1 | |
14928 | IF(ITER.GT.50) THEN | |
14929 | IREJ = 1 | |
14930 | C debug output | |
14931 | IF(IDEB(41).GE.2) WRITE(LO,'(/1X,A,2I7,1P,E12.4)') | |
14932 | & 'PHO_REGFLA: rejection, no reggeon found for', | |
14933 | & IDHEP(JM1),IDHEP(JM2),E1 | |
14934 | RETURN | |
14935 | ENDIF | |
14936 | ||
14937 | CALL PHO_VALFLA(JM1,IFLA1,IFLA2,E1,E1) | |
14938 | CALL PHO_VALFLA(JM2,IFLB1,IFLB2,E1,E1) | |
14939 | IF(IFLA1.EQ.-IFLB1) THEN | |
14940 | IFLR1 = IFLA2 | |
14941 | IFLR2 = IFLB2 | |
14942 | ELSE IF(IFLA1.EQ.-IFLB2) THEN | |
14943 | IFLR1 = IFLA2 | |
14944 | IFLR2 = IFLB1 | |
14945 | ELSE IF(IFLA2.EQ.-IFLB1) THEN | |
14946 | IFLR1 = IFLA1 | |
14947 | IFLR2 = IFLB2 | |
14948 | ELSE IF(IFLA2.EQ.-IFLB2) THEN | |
14949 | IFLR1 = IFLA1 | |
14950 | IFLR2 = IFLB1 | |
14951 | ELSE | |
14952 | C debug output | |
14953 | IF(IDEB(41).GE.25) WRITE(LO,'(/1X,A,3I4)') | |
14954 | & 'PHO_REGFLA: int.rejection JM1,JM2,ITRY',JM1,JM2,ITER | |
14955 | GOTO 50 | |
14956 | ENDIF | |
14957 | C debug output | |
14958 | IF(IDEB(41).GE.10) WRITE(LO,'(1X,A,/5X,2I4,2I6,2I5,1PE10.3)') | |
14959 | & 'PHO_REGFLA: JM1/2,PDG-ID1/2,IFLR1/2,MASS', | |
14960 | & JM1,JM2,IDHEP(JM1),IDHEP(JM2),IFLR1,IFLR2,E1 | |
14961 | ELSE IF(JM1.EQ.-1) THEN | |
14962 | C initialization | |
14963 | ELSE IF(JM1.EQ.-2) THEN | |
14964 | C output of statistics | |
14965 | ELSE | |
14966 | WRITE(LO,'(1X,A,I10)') | |
14967 | & 'PHO_REGFLA: invalid mother particle (JM1)',JM1 | |
14968 | CALL PHO_ABORT | |
14969 | ENDIF | |
14970 | ||
14971 | END | |
14972 | ||
14973 | *$ CREATE PHO_SEAFLA.FOR | |
14974 | *COPY PHO_SEAFLA | |
14975 | CDECK ID>, PHO_SEAFLA | |
14976 | SUBROUTINE PHO_SEAFLA(IPAR,IFL1,IFL2,CHMASS) | |
14977 | C********************************************************************** | |
14978 | C | |
14979 | C selection of sea flavour content of particle IPAR | |
14980 | C | |
14981 | C input: IPAR particle index in /POEVT1/ | |
14982 | C CHMASS available invariant string mass | |
14983 | C positive mass --> use BAMJET method | |
14984 | C negative mass --> SU(3) symmetric sea according | |
14985 | C to values given in PARMDL(1-6) | |
14986 | C IPAR -1 initialization | |
14987 | C -2 output of statistics | |
14988 | C | |
14989 | C output: sea flavours according to PDG conventions | |
14990 | C | |
14991 | C********************************************************************** | |
14992 | IMPLICIT DOUBLE PRECISION (A-H,O-Z) | |
14993 | SAVE | |
14994 | ||
14995 | PARAMETER ( EPS = 0.1D0, | |
14996 | & DEPS = 1.D-15) | |
14997 | ||
14998 | C input/output channels | |
14999 | INTEGER LI,LO | |
15000 | COMMON /POINOU/ LI,LO | |
15001 | C event debugging information | |
15002 | INTEGER NMAXD | |
15003 | PARAMETER (NMAXD=100) | |
15004 | INTEGER IDEB,KSPOM,KHPOM,KSREG,KHDIR,KACCEP,KSTRG,KHTRG,KSLOO, | |
15005 | & KHLOO,KSDPO,KHDPO,KEVENT,KSOFT,KHARD | |
15006 | COMMON /PODEBG/ IDEB(NMAXD),KSPOM,KHPOM,KSREG,KHDIR,KACCEP,KSTRG, | |
15007 | & KHTRG,KSLOO,KHLOO,KSDPO,KHDPO,KEVENT,KSOFT,KHARD | |
15008 | C model switches and parameters | |
15009 | CHARACTER*8 MDLNA | |
15010 | INTEGER ISWMDL,IPAMDL | |
15011 | DOUBLE PRECISION PARMDL | |
15012 | COMMON /POMDLS/ MDLNA(50),ISWMDL(50),PARMDL(400),IPAMDL(400) | |
15013 | C some hadron information, will be deleted in future versions | |
15014 | INTEGER NFS | |
15015 | DOUBLE PRECISION QMASS,BET,PCOUDI,PNORM,VALPRG | |
15016 | COMMON /POHDRN/ QMASS(6),BET,PCOUDI,PNORM,VALPRG(2),NFS | |
15017 | ||
15018 | IF(IPAR.GT.0) THEN | |
15019 | IF((ISWMDL(20).EQ.1).OR.(CHMASS.LT.0.D0)) THEN | |
15020 | C constant weights for sea | |
15021 | 15 CONTINUE | |
15022 | SUM = 0.D0 | |
15023 | DO 40 K=1,NFSEA | |
15024 | SUM = SUM + PARMDL(K) | |
15025 | 40 CONTINUE | |
15026 | XI = DT_RNDM(SUM)*SUM | |
15027 | SUM = 0.D0 | |
15028 | DO 50 K=1,NFSEA | |
15029 | SUM = SUM + PARMDL(K) | |
15030 | IF(XI.LE.SUM) GOTO 55 | |
15031 | 50 CONTINUE | |
15032 | 55 CONTINUE | |
15033 | IF(K.GT.NFSEA) GOTO 15 | |
15034 | ELSE | |
15035 | C mass dependent flavour sampling | |
15036 | 10 CONTINUE | |
15037 | CALL PHO_FLAUX(CHMASS,K) | |
15038 | IF(K.GT.NFSEA) GOTO 10 | |
15039 | ENDIF | |
15040 | IF(DT_RNDM(CHMASS).GT.0.5D0) K = -K | |
15041 | IFL1 = K | |
15042 | IFL2 = -K | |
15043 | IF(IDEB(46).GE.10) THEN | |
15044 | WRITE(LO,'(1X,A,3I5,E12.4)') 'PHO_SEAFLA:IPAR,IFL1,IFL2,MASS', | |
15045 | & IPAR,IFL1,IFL2,CHMASS | |
15046 | ENDIF | |
15047 | ELSE IF(IPAR.EQ.-1) THEN | |
15048 | C initialization | |
15049 | NFSEA = NFS | |
15050 | ELSE IF(IPAR.EQ.-2) THEN | |
15051 | C output of statistics | |
15052 | ELSE | |
15053 | WRITE(LO,'(1X,A,I10)') 'PHO_SEAFLA:ERROR:INVALID IPAR',IPAR | |
15054 | CALL PHO_ABORT | |
15055 | ENDIF | |
15056 | ||
15057 | END | |
15058 | ||
15059 | *$ CREATE PHO_FLAUX.FOR | |
15060 | *COPY PHO_FLAUX | |
15061 | CDECK ID>, PHO_FLAUX | |
15062 | SUBROUTINE PHO_FLAUX(EQUARK,K) | |
15063 | C*********************************************************************** | |
15064 | C | |
15065 | C auxiliary subroutine to select flavours | |
15066 | C | |
15067 | C******************************************************************** | |
15068 | IMPLICIT DOUBLE PRECISION (A-H,O-Z) | |
15069 | SAVE | |
15070 | ||
15071 | PARAMETER ( DEPS = 1.D-14 ) | |
15072 | ||
15073 | C input/output channels | |
15074 | INTEGER LI,LO | |
15075 | COMMON /POINOU/ LI,LO | |
15076 | C event debugging information | |
15077 | INTEGER NMAXD | |
15078 | PARAMETER (NMAXD=100) | |
15079 | INTEGER IDEB,KSPOM,KHPOM,KSREG,KHDIR,KACCEP,KSTRG,KHTRG,KSLOO, | |
15080 | & KHLOO,KSDPO,KHDPO,KEVENT,KSOFT,KHARD | |
15081 | COMMON /PODEBG/ IDEB(NMAXD),KSPOM,KHPOM,KSREG,KHDIR,KACCEP,KSTRG, | |
15082 | & KHTRG,KSLOO,KHLOO,KSDPO,KHDPO,KEVENT,KSOFT,KHARD | |
15083 | C some hadron information, will be deleted in future versions | |
15084 | INTEGER NFS | |
15085 | DOUBLE PRECISION QMASS,BET,PCOUDI,PNORM,VALPRG | |
15086 | COMMON /POHDRN/ QMASS(6),BET,PCOUDI,PNORM,VALPRG(2),NFS | |
15087 | ||
15088 | DIMENSION WGHT(9) | |
15089 | ||
15090 | C calculate weights for given energy | |
15091 | IF(EQUARK.LT.QMASS(1)) THEN | |
15092 | IF(IDEB(16).GE.5) | |
15093 | & WRITE(LO,'(1X,A,E12.3)') 'PHO_FLAUX: VERY SMALL MASS', | |
15094 | & EQUARK | |
15095 | WGHT(1) = 0.5D0 | |
15096 | WGHT(2) = 0.5D0 | |
15097 | WGHT(3) = 0.D0 | |
15098 | WGHT(4) = 0.D0 | |
15099 | SUM = 1.D0 | |
15100 | ELSE | |
15101 | SUM = 0.D0 | |
15102 | DO 305 K=1,NFS | |
15103 | IF(EQUARK.GT.QMASS(K)) THEN | |
15104 | WGHT(K) = PHO_BETAF(EQUARK,QMASS(K),BET) | |
15105 | ELSE | |
15106 | WGHT(K) = 0.D0 | |
15107 | ENDIF | |
15108 | SUM = SUM + WGHT(K) | |
15109 | 305 CONTINUE | |
15110 | ENDIF | |
15111 | C sample flavours | |
15112 | XI = SUM*(DT_RNDM(SUM)-DEPS) | |
15113 | K = 0 | |
15114 | SUM = 0.D0 | |
15115 | 400 CONTINUE | |
15116 | K = K+1 | |
15117 | SUM = SUM + WGHT(K) | |
15118 | IF(XI.GT.SUM) GOTO 400 | |
15119 | C debug output | |
15120 | IF(IDEB(16).GE.20) THEN | |
15121 | WRITE(LO,'(1X,A,I5)') 'PHO_FLAUX: selected flavour',K | |
15122 | ENDIF | |
15123 | END | |
15124 | ||
15125 | *$ CREATE PHO_BETAF.FOR | |
15126 | *COPY PHO_BETAF | |
15127 | CDECK ID>, PHO_BETAF | |
15128 | DOUBLE PRECISION FUNCTION PHO_BETAF(X1,X2,BET) | |
15129 | C******************************************************************** | |
15130 | C | |
15131 | C weights of different quark flavours | |
15132 | C | |
15133 | C******************************************************************** | |
15134 | IMPLICIT DOUBLE PRECISION (A-H,O-Z) | |
15135 | SAVE | |
15136 | ||
15137 | AX=0.D0 | |
15138 | BETX1=BET*X1 | |
15139 | IF(BETX1.LT.70.D0) AX=-1.D0/BET**2*(BETX1+1.D0)*EXP(-BETX1) | |
15140 | AY=1.D0/BET**2*(BET*X2+1.D0)*EXP(-BET*X2) | |
15141 | ||
15142 | PHO_BETAF=AX+AY | |
15143 | ||
15144 | END | |
15145 | ||
15146 | *$ CREATE PHO_MCHECK.FOR | |
15147 | *COPY PHO_MCHECK | |
15148 | CDECK ID>, PHO_MCHECK | |
15149 | SUBROUTINE PHO_MCHECK(J1,IREJ) | |
15150 | C******************************************************************** | |
15151 | C | |
15152 | C check parton momenta for fragmentation | |
15153 | C | |
15154 | C input: J1 first string number | |
15155 | C /POEVT1/ | |
15156 | C /POSTRG/ | |
15157 | C | |
15158 | C output: /POEVT1/ | |
15159 | C /POSTRG/ | |
15160 | C IREJ 0 successful | |
15161 | C 1 failure | |
15162 | C | |
15163 | C in case of very small string mass: | |
15164 | C NNCH mass label of string | |
15165 | C 0 string | |
15166 | C -1 octett baryon / pseudo scalar meson | |
15167 | C 1 decuplett baryon / vector meson | |
15168 | C IBHAD hadron number according to CPC, | |
15169 | C string will be treated as resonance | |
15170 | C (sometimes far off mass shell) | |
15171 | C | |
15172 | C constant WIDTH ( 0.01GeV ) determines range of acceptance | |
15173 | C | |
15174 | C******************************************************************** | |
15175 | IMPLICIT DOUBLE PRECISION (A-H,O-Z) | |
15176 | SAVE | |
15177 | ||
15178 | PARAMETER ( WIDTH = 0.01D0, | |
15179 | & DEPS = 1.D-15 ) | |
15180 | ||
15181 | C input/output channels | |
15182 | INTEGER LI,LO | |
15183 | COMMON /POINOU/ LI,LO | |
15184 | C event debugging information | |
15185 | INTEGER NMAXD | |
15186 | PARAMETER (NMAXD=100) | |
15187 | INTEGER IDEB,KSPOM,KHPOM,KSREG,KHDIR,KACCEP,KSTRG,KHTRG,KSLOO, | |
15188 | & KHLOO,KSDPO,KHDPO,KEVENT,KSOFT,KHARD | |
15189 | COMMON /PODEBG/ IDEB(NMAXD),KSPOM,KHPOM,KSREG,KHDIR,KACCEP,KSTRG, | |
15190 | & KHTRG,KSLOO,KHLOO,KSDPO,KHDPO,KEVENT,KSOFT,KHARD | |
15191 | C model switches and parameters | |
15192 | CHARACTER*8 MDLNA | |
15193 | INTEGER ISWMDL,IPAMDL | |
15194 | DOUBLE PRECISION PARMDL | |
15195 | COMMON /POMDLS/ MDLNA(50),ISWMDL(50),PARMDL(400),IPAMDL(400) | |
15196 | C standard particle data interface | |
15197 | INTEGER NMXHEP | |
15198 | PARAMETER (NMXHEP=4000) | |
15199 | INTEGER NEVHEP,NHEP,ISTHEP,IDHEP,JMOHEP,JDAHEP | |
15200 | DOUBLE PRECISION PHEP,VHEP | |
15201 | COMMON /POEVT1/ NEVHEP,NHEP,ISTHEP(NMXHEP),IDHEP(NMXHEP), | |
15202 | & JMOHEP(2,NMXHEP),JDAHEP(2,NMXHEP),PHEP(5,NMXHEP), | |
15203 | & VHEP(4,NMXHEP) | |
15204 | C extension to standard particle data interface (PHOJET specific) | |
15205 | INTEGER IMPART,IPHIST,ICOLOR | |
15206 | COMMON /POEVT2/ IMPART(NMXHEP),IPHIST(2,NMXHEP),ICOLOR(2,NMXHEP) | |
15207 | C color string configurations including collapsed strings and hadrons | |
15208 | INTEGER MSTR | |
15209 | PARAMETER (MSTR=500) | |
15210 | INTEGER NPOS,NCODE,IPAR1,IPAR2,IPAR3,IPAR4,NNCH,IBHAD | |
15211 | COMMON /POSTRG/ NPOS(4,MSTR),NCODE(MSTR), | |
15212 | & IPAR1(MSTR),IPAR2(MSTR),IPAR3(MSTR),IPAR4(MSTR), | |
15213 | & NNCH(MSTR),IBHAD(MSTR),ISTR | |
15214 | C internal rejection counters | |
15215 | INTEGER NMXJ | |
15216 | PARAMETER (NMXJ=60) | |
15217 | CHARACTER*10 REJTIT | |
15218 | INTEGER IFAIL | |
15219 | COMMON /POLOOP/ IFAIL(NMXJ),REJTIT(NMXJ) | |
15220 | ||
15221 | IREJ = 0 | |
15222 | C quark antiquark jet | |
15223 | STRM = PHEP(5,NPOS(1,J1)) | |
15224 | IF(NCODE(J1).EQ.3) THEN | |
15225 | CALL PHO_MEMASS(IPAR1(J1),IPAR2(J1), | |
15226 | & AMPS,AMPS2,AMVE,AMVE2,IPS,IVE) | |
15227 | IF(IDEB(18).GE.5) | |
15228 | & WRITE(LO,'(1X,A,/3X,I3,5E12.3)') | |
15229 | & 'PHO_MCHECK:1.STRING NO, CHMASS,AMPS,AMPS2,AMVE,AMVE2 ', | |
15230 | & J1,STRM,AMPS,AMPS2,AMVE,AMVE2 | |
15231 | IF(STRM.LT.AMPS) THEN | |
15232 | IREJ = 1 | |
15233 | IFAIL(20) = IFAIL(20) + 1 | |
15234 | RETURN | |
15235 | ELSE IF(STRM.LT.AMPS2) THEN | |
15236 | IF(STRM.LT.(AMVE-WIDTH)) THEN | |
15237 | NNCH(J1) = -1 | |
15238 | IBHAD(J1) = IPS | |
15239 | ELSE | |
15240 | NNCH(J1) = 1 | |
15241 | IBHAD(J1) = IVE | |
15242 | ENDIF | |
15243 | ELSE | |
15244 | NNCH(J1) = 0 | |
15245 | IBHAD(J1) = 0 | |
15246 | ENDIF | |
15247 | C quark diquark or v.s. jet | |
15248 | ELSE IF((NCODE(J1).EQ.4).OR.(NCODE(J1).EQ.6)) THEN | |
15249 | CALL PHO_BAMASS(IPAR1(J1),IPAR2(J1),IPAR3(J1), | |
15250 | & AM8,AM82,AM10,AM102,I8,I10) | |
15251 | IF(IDEB(18).GE.5) | |
15252 | & WRITE(LO,'(1X,A,/5X,I3,5E12.3)') | |
15253 | & 'PHO_MCHECK:1.STRING NO, CHMASS,AM8,AM82,AM10,AM102 ', | |
15254 | & J1,STRM,AM8,AM82,AM10,AM102 | |
15255 | IF(STRM.LT.AM8) THEN | |
15256 | IREJ = 1 | |
15257 | IFAIL(19) = IFAIL(19) + 1 | |
15258 | RETURN | |
15259 | ELSE IF(STRM.LT.AM82) THEN | |
15260 | IF(STRM.LT.(AM10-WIDTH)) THEN | |
15261 | NNCH(J1) = -1 | |
15262 | IBHAD(J1) = I8 | |
15263 | ELSE | |
15264 | NNCH(J1) = 1 | |
15265 | IBHAD(J1) = I10 | |
15266 | ENDIF | |
15267 | ELSE | |
15268 | NNCH(J1) = 0 | |
15269 | IBHAD(J1) = 0 | |
15270 | ENDIF | |
15271 | C diquark a-diquark string | |
15272 | ELSE IF(NCODE(J1).EQ.5) THEN | |
15273 | CALL PHO_DQMASS(IPAR1(J1),IPAR2(J1),IPAR3(J1),IPAR4(J1), | |
15274 | & AM82,AM102) | |
15275 | IF(IDEB(18).GE.5) | |
15276 | & WRITE(LO,'(1X,A,/5X,I3,3E12.3)') | |
15277 | & 'PHO_MCHECK:1.STRING NO, CHMASS,AM82,AM102 ', | |
15278 | & J1,STRM,AM82,AM102 | |
15279 | IF(STRM.LT.AM82) THEN | |
15280 | IREJ = 1 | |
15281 | IFAIL(19) = IFAIL(19) + 1 | |
15282 | RETURN | |
15283 | ELSE | |
15284 | NNCH(J1) = 0 | |
15285 | IBHAD(J1) = 0 | |
15286 | ENDIF | |
15287 | ELSE IF(NCODE(J1).LT.0) THEN | |
15288 | RETURN | |
15289 | ELSE | |
15290 | WRITE(LO,'(/,1X,2A,2I8)') 'PHO_MCHECK: ', | |
15291 | & 'inconsistent flavours for string (NO,NCODE)',J1,NCODE(J1) | |
15292 | CALL PHO_ABORT | |
15293 | ENDIF | |
15294 | END | |
15295 | ||
15296 | *$ CREATE PHO_POMCOR.FOR | |
15297 | *COPY PHO_POMCOR | |
15298 | CDECK ID>, PHO_POMCOR | |
15299 | SUBROUTINE PHO_POMCOR(IREJ) | |
15300 | C******************************************************************** | |
15301 | C | |
15302 | C join quarks to gluons in case of too small masses | |
15303 | C | |
15304 | C input: /POEVT1/ | |
15305 | C /POSTRG/ | |
15306 | C IREJ -1 initialization | |
15307 | C -2 output of statistics | |
15308 | C | |
15309 | C output: /POEVT1/ | |
15310 | C /POSTRG/ | |
15311 | C IREJ 0 successful | |
15312 | C 1 failure | |
15313 | C | |
15314 | C | |
15315 | C******************************************************************** | |
15316 | IMPLICIT DOUBLE PRECISION (A-H,O-Z) | |
15317 | SAVE | |
15318 | ||
15319 | PARAMETER ( EPS = 1.D-10 ) | |
15320 | ||
15321 | C input/output channels | |
15322 | INTEGER LI,LO | |
15323 | COMMON /POINOU/ LI,LO | |
15324 | C event debugging information | |
15325 | INTEGER NMAXD | |
15326 | PARAMETER (NMAXD=100) | |
15327 | INTEGER IDEB,KSPOM,KHPOM,KSREG,KHDIR,KACCEP,KSTRG,KHTRG,KSLOO, | |
15328 | & KHLOO,KSDPO,KHDPO,KEVENT,KSOFT,KHARD | |
15329 | COMMON /PODEBG/ IDEB(NMAXD),KSPOM,KHPOM,KSREG,KHDIR,KACCEP,KSTRG, | |
15330 | & KHTRG,KSLOO,KHLOO,KSDPO,KHDPO,KEVENT,KSOFT,KHARD | |
15331 | C model switches and parameters | |
15332 | CHARACTER*8 MDLNA | |
15333 | INTEGER ISWMDL,IPAMDL | |
15334 | DOUBLE PRECISION PARMDL | |
15335 | COMMON /POMDLS/ MDLNA(50),ISWMDL(50),PARMDL(400),IPAMDL(400) | |
15336 | C standard particle data interface | |
15337 | INTEGER NMXHEP | |
15338 | PARAMETER (NMXHEP=4000) | |
15339 | INTEGER NEVHEP,NHEP,ISTHEP,IDHEP,JMOHEP,JDAHEP | |
15340 | DOUBLE PRECISION PHEP,VHEP | |
15341 | COMMON /POEVT1/ NEVHEP,NHEP,ISTHEP(NMXHEP),IDHEP(NMXHEP), | |
15342 | & JMOHEP(2,NMXHEP),JDAHEP(2,NMXHEP),PHEP(5,NMXHEP), | |
15343 | & VHEP(4,NMXHEP) | |
15344 | C extension to standard particle data interface (PHOJET specific) | |
15345 | INTEGER IMPART,IPHIST,ICOLOR | |
15346 | COMMON /POEVT2/ IMPART(NMXHEP),IPHIST(2,NMXHEP),ICOLOR(2,NMXHEP) | |
15347 | C color string configurations including collapsed strings and hadrons | |
15348 | INTEGER MSTR | |
15349 | PARAMETER (MSTR=500) | |
15350 | INTEGER NPOS,NCODE,IPAR1,IPAR2,IPAR3,IPAR4,NNCH,IBHAD | |
15351 | COMMON /POSTRG/ NPOS(4,MSTR),NCODE(MSTR), | |
15352 | & IPAR1(MSTR),IPAR2(MSTR),IPAR3(MSTR),IPAR4(MSTR), | |
15353 | & NNCH(MSTR),IBHAD(MSTR),ISTR | |
15354 | ||
15355 | DIMENSION PJ(4) | |
15356 | ||
15357 | IF(IREJ.EQ.-1) THEN | |
15358 | ICTOT = 0 | |
15359 | ICCOR = 0 | |
15360 | RETURN | |
15361 | ELSE IF(IREJ.EQ.-2) THEN | |
15362 | WRITE(LO,'(/1X,A,2I8)') | |
15363 | & 'PHO_POMCOR: total/joined strings',ICTOT,ICCOR | |
15364 | RETURN | |
15365 | ENDIF | |
15366 | C | |
15367 | IREJ = 0 | |
15368 | C | |
15369 | NITER = 100 | |
15370 | ITER = 0 | |
15371 | ICTOT = ICTOT+ISTR | |
15372 | IF(ISWMDL(25).LE.0) RETURN | |
15373 | C debug string entries | |
15374 | IF(IDEB(83).GE.25) CALL PHO_PRSTRG | |
15375 | C | |
15376 | 50 CONTINUE | |
15377 | ITER = ITER+1 | |
15378 | IF(ITER.GE.NITER) THEN | |
15379 | IREJ = 1 | |
15380 | IF(IDEB(83).GE.2) THEN | |
15381 | WRITE(LO,'(1X,A,2I5)') 'PHO_POMCOR: rejection',ITER,NITER | |
15382 | IF(IDEB(83).GE.10) CALL PHO_PREVNT(0) | |
15383 | ENDIF | |
15384 | RETURN | |
15385 | ENDIF | |
15386 | C | |
15387 | C check mass limits | |
15388 | ISTRO = ISTR | |
15389 | DO 100 I=1,ISTRO | |
15390 | IF(NCODE(I).LT.0) GOTO 99 | |
15391 | J1 = NPOS(1,I) | |
15392 | NRPOM = IPHIST(2,J1) | |
15393 | IF(NRPOM.GE.100) GOTO 99 | |
15394 | CMASS0 = PHEP(5,J1) | |
15395 | C get masses | |
15396 | IF(NCODE(I).EQ.3) THEN | |
15397 | CALL PHO_MEMASS(IPAR1(I),IPAR2(I),AM1,AM2,AM3,AM4,IP1,IP2) | |
15398 | ELSE IF((NCODE(I).EQ.4).OR.(NCODE(I).EQ.6)) THEN | |
15399 | CALL PHO_BAMASS(IPAR1(I),IPAR2(I),IPAR3(I), | |
15400 | & AM1,AM2,AM3,AM4,IP1,IP2) | |
15401 | ELSE IF(NCODE(I).EQ.5) THEN | |
15402 | CALL PHO_DQMASS(IPAR1(I),IPAR2(I),IPAR3(I),IPAR4(I), | |
15403 | & AM1,AM2) | |
15404 | AM3 = 0.D0 | |
15405 | AM4 = 0.D0 | |
15406 | IP1 = 0 | |
15407 | IP2 = 0 | |
15408 | ELSE IF(NCODE(I).EQ.7) THEN | |
15409 | GOTO 99 | |
15410 | ELSE IF(NCODE(I).LT.0) THEN | |
15411 | GOTO 99 | |
15412 | ELSE | |
15413 | WRITE(LO,'(/,1X,A,2I5)') 'ERROR:PHO_POMCOR:STRING NO,NCODE ', | |
15414 | & J1,NCODE(I) | |
15415 | CALL PHO_ABORT | |
15416 | ENDIF | |
15417 | IF(IDEB(83).GE.5) | |
15418 | & WRITE(LO,'(1X,A,/3X,2I4,5E11.3,2I5)') | |
15419 | & 'PHO_POMCOR: STRING,POM,CHMASS,AM1,AM2,AM3,AM4,IP1,IP2', | |
15420 | & I,NRPOM,CMASS0,AM1,AM2,AM3,AM4,IP1,IP2 | |
15421 | C select masses to correct | |
15422 | IF(CMASS0.LT.MAX(AM2,AM4)) THEN | |
15423 | DO 200 K=1,ISTRO | |
15424 | IF((K.NE.I).AND.(NCODE(K).GE.0)) THEN | |
15425 | J2 = NPOS(1,K) | |
15426 | C join quarks to gluon | |
15427 | IF(NRPOM.EQ.IPHIST(2,J2)) THEN | |
15428 | C flavour check | |
15429 | IFL1 = 0 | |
15430 | IFL2 = 0 | |
15431 | PROB1 = 0.D0 | |
15432 | PROB2 = 0.D0 | |
15433 | KK1 = NPOS(2,I) | |
15434 | KK2 = NPOS(2,K) | |
15435 | IF(IDHEP(KK1)+IDHEP(KK2).EQ.0) THEN | |
15436 | CMASS = (PHEP(4,KK1)+PHEP(4,KK2))**2 | |
15437 | & -(PHEP(1,KK1)+PHEP(1,KK2))**2 | |
15438 | & -(PHEP(2,KK1)+PHEP(2,KK2))**2 | |
15439 | & -(PHEP(2,KK1)+PHEP(2,KK2))**2 | |
15440 | IFL1 = ABS(IDHEP(KK1)) | |
15441 | IF(IFL1.GT.2) THEN | |
15442 | PROB1 = 0.1D0/MAX(CMASS,EPS) | |
15443 | ELSE | |
15444 | PROB1 = 0.9D0/MAX(CMASS,EPS) | |
15445 | ENDIF | |
15446 | ENDIF | |
15447 | KK1 = ABS(NPOS(3,I)) | |
15448 | KK2 = ABS(NPOS(3,K)) | |
15449 | IF(IDHEP(KK1)+IDHEP(KK2).EQ.0) THEN | |
15450 | CMASS = (PHEP(4,KK1)+PHEP(4,KK2))**2 | |
15451 | & -(PHEP(1,KK1)+PHEP(1,KK2))**2 | |
15452 | & -(PHEP(2,KK1)+PHEP(2,KK2))**2 | |
15453 | & -(PHEP(2,KK1)+PHEP(2,KK2))**2 | |
15454 | IFL2 = ABS(IDHEP(KK1)) | |
15455 | IF(IFL2.GT.2) THEN | |
15456 | PROB2 = 0.1D0/MAX(CMASS,EPS) | |
15457 | ELSE | |
15458 | PROB2 = 0.9D0/MAX(CMASS,EPS) | |
15459 | ENDIF | |
15460 | ENDIF | |
15461 | IF(IFL1+IFL2.EQ.0) GOTO 99 | |
15462 | C fusion possible | |
15463 | ICCOR = ICCOR+1 | |
15464 | IF((DT_RNDM(CMASS)*(PROB1+PROB2)).LT.PROB1) THEN | |
15465 | JJ = 2 | |
15466 | JE = 3 | |
15467 | ELSE | |
15468 | JJ = 3 | |
15469 | JE = 2 | |
15470 | ENDIF | |
15471 | KK1 = ABS(NPOS(JJ,I)) | |
15472 | KK2 = ABS(NPOS(JJ,K)) | |
15473 | I1 = ABS(NPOS(JE,I)) | |
15474 | I2 = KK1 | |
15475 | IS = SIGN(1,I2-I1) | |
15476 | I2 = I2 - IS | |
15477 | K1 = KK2 | |
15478 | K2 = ABS(NPOS(JE,K)) | |
15479 | KS = SIGN(1,K2-K1) | |
15480 | K1 = K1 + KS | |
15481 | IP1 = NHEP+1 | |
15482 | C copy mother partons of string I | |
15483 | DO 300 II=I1,I2,IS | |
15484 | CALL PHO_REGPAR(-1,IDHEP(II),0,J1,J2,PHEP(1,II), | |
15485 | & PHEP(2,II),PHEP(3,II),PHEP(4,II),I,IPHIST(2,II), | |
15486 | & ICOLOR(1,II),ICOLOR(2,II),IPOS,1) | |
15487 | 300 CONTINUE | |
15488 | C register gluon | |
15489 | DO 350 II=1,4 | |
15490 | PJ(II) = PHEP(II,KK1)+PHEP(II,KK2) | |
15491 | 350 CONTINUE | |
15492 | CALL PHO_REGPAR(-1,21,0,J1,J2,PJ(1),PJ(2),PJ(3),PJ(4), | |
15493 | & I,IPHIST(2,KK2),ICOLOR(1,KK1),ICOLOR(1,KK2),IPOS,1) | |
15494 | C copy mother partons of string K | |
15495 | DO 400 II=K1,K2,KS | |
15496 | CALL PHO_REGPAR(-1,IDHEP(II),0,J1,J2,PHEP(1,II), | |
15497 | & PHEP(2,II),PHEP(3,II),PHEP(4,II),I,IPHIST(2,II), | |
15498 | & ICOLOR(1,II),ICOLOR(2,II),IPOS,1) | |
15499 | 400 CONTINUE | |
15500 | C create new string entry | |
15501 | DO 450 II=1,4 | |
15502 | PJ(II) = PHEP(II,J1)+PHEP(II,J2) | |
15503 | 450 CONTINUE | |
15504 | IP2 = IPOS | |
15505 | CALL PHO_REGPAR(-1,90,0,IP1,-IP2,PJ(1),PJ(2),PJ(3), | |
15506 | & PJ(4),I,IPHIST(2,J1),ICOLOR(1,J1)+ICOLOR(1,J2), | |
15507 | & ICOLOR(2,J1)+ICOLOR(2,J2),IPOS,1) | |
15508 | C delete string K in /POSTRG/ | |
15509 | NCODE(K) = -999 | |
15510 | C update string I in /POSTRG/ | |
15511 | NPOS(1,I) = IPOS | |
15512 | NPOS(2,I) = IP1 | |
15513 | NPOS(3,I) = -IP2 | |
15514 | C calculate new CPC string codes | |
15515 | CALL PHO_ID2STR(IDHEP(IP1),IDHEP(IP2),NCODE(I),IPAR1(I), | |
15516 | & IPAR2(I),IPAR3(I),IPAR4(I)) | |
15517 | GOTO 99 | |
15518 | ENDIF | |
15519 | ENDIF | |
15520 | 200 CONTINUE | |
15521 | ENDIF | |
15522 | 99 CONTINUE | |
15523 | 100 CONTINUE | |
15524 | IF(IDEB(83).GE.20) THEN | |
15525 | WRITE(LO,'(1X,A)') 'PHO_POMCOR: after string recombination' | |
15526 | IF(IDEB(83).GE.22) THEN | |
15527 | CALL PHO_PRSTRG | |
15528 | CALL PHO_PREVNT(0) | |
15529 | ENDIF | |
15530 | ENDIF | |
15531 | ||
15532 | END | |
15533 | ||
15534 | *$ CREATE PHO_MASCOR.FOR | |
15535 | *COPY PHO_MASCOR | |
15536 | CDECK ID>, PHO_MASCOR | |
15537 | SUBROUTINE PHO_MASCOR(IREJ) | |
15538 | C******************************************************************** | |
15539 | C | |
15540 | C check and adjust parton momenta for fragmentation | |
15541 | C | |
15542 | C input: /POEVT1/ | |
15543 | C /POSTRG/ | |
15544 | C IREJ -1 initialization | |
15545 | C -2 output of statistics | |
15546 | C | |
15547 | C output: /POEVT1/ | |
15548 | C /POSTRG/ | |
15549 | C IREJ 0 successful | |
15550 | C 1 failure | |
15551 | C | |
15552 | C in case of very small string mass: | |
15553 | C - direct manipulation of /POEVT1/ and /POEVT2/ | |
15554 | C - string will be deleted from /POSTRG/ (label -99) | |
15555 | C | |
15556 | C******************************************************************** | |
15557 | IMPLICIT DOUBLE PRECISION (A-H,O-Z) | |
15558 | SAVE | |
15559 | ||
15560 | PARAMETER ( EPS = 1.D-10, | |
15561 | & EMIN = 0.3D0, | |
15562 | & DEPS = 1.D-15) | |
15563 | ||
15564 | C input/output channels | |
15565 | INTEGER LI,LO | |
15566 | COMMON /POINOU/ LI,LO | |
15567 | C event debugging information | |
15568 | INTEGER NMAXD | |
15569 | PARAMETER (NMAXD=100) | |
15570 | INTEGER IDEB,KSPOM,KHPOM,KSREG,KHDIR,KACCEP,KSTRG,KHTRG,KSLOO, | |
15571 | & KHLOO,KSDPO,KHDPO,KEVENT,KSOFT,KHARD | |
15572 | COMMON /PODEBG/ IDEB(NMAXD),KSPOM,KHPOM,KSREG,KHDIR,KACCEP,KSTRG, | |
15573 | & KHTRG,KSLOO,KHLOO,KSDPO,KHDPO,KEVENT,KSOFT,KHARD | |
15574 | C internal rejection counters | |
15575 | INTEGER NMXJ | |
15576 | PARAMETER (NMXJ=60) | |
15577 | CHARACTER*10 REJTIT | |
15578 | INTEGER IFAIL | |
15579 | COMMON /POLOOP/ IFAIL(NMXJ),REJTIT(NMXJ) | |
15580 | C model switches and parameters | |
15581 | CHARACTER*8 MDLNA | |
15582 | INTEGER ISWMDL,IPAMDL | |
15583 | DOUBLE PRECISION PARMDL | |
15584 | COMMON /POMDLS/ MDLNA(50),ISWMDL(50),PARMDL(400),IPAMDL(400) | |
15585 | C standard particle data interface | |
15586 | INTEGER NMXHEP | |
15587 | PARAMETER (NMXHEP=4000) | |
15588 | INTEGER NEVHEP,NHEP,ISTHEP,IDHEP,JMOHEP,JDAHEP | |
15589 | DOUBLE PRECISION PHEP,VHEP | |
15590 | COMMON /POEVT1/ NEVHEP,NHEP,ISTHEP(NMXHEP),IDHEP(NMXHEP), | |
15591 | & JMOHEP(2,NMXHEP),JDAHEP(2,NMXHEP),PHEP(5,NMXHEP), | |
15592 | & VHEP(4,NMXHEP) | |
15593 | C extension to standard particle data interface (PHOJET specific) | |
15594 | INTEGER IMPART,IPHIST,ICOLOR | |
15595 | COMMON /POEVT2/ IMPART(NMXHEP),IPHIST(2,NMXHEP),ICOLOR(2,NMXHEP) | |
15596 | C color string configurations including collapsed strings and hadrons | |
15597 | INTEGER MSTR | |
15598 | PARAMETER (MSTR=500) | |
15599 | INTEGER NPOS,NCODE,IPAR1,IPAR2,IPAR3,IPAR4,NNCH,IBHAD | |
15600 | COMMON /POSTRG/ NPOS(4,MSTR),NCODE(MSTR), | |
15601 | & IPAR1(MSTR),IPAR2(MSTR),IPAR3(MSTR),IPAR4(MSTR), | |
15602 | & NNCH(MSTR),IBHAD(MSTR),ISTR | |
15603 | ||
15604 | DIMENSION PC1(4),PC2(4),P1(4),PTR(4),GAM(3),GAMB(3) | |
15605 | ||
15606 | IF(IREJ.EQ.-1) THEN | |
15607 | ICTOT = 0 | |
15608 | ICCOR = 0 | |
15609 | RETURN | |
15610 | ELSE IF(IREJ.EQ.-2) THEN | |
15611 | WRITE(LO,'(/1X,A,2I8/)') | |
15612 | & 'PHO_MASCOR: total/converted strings',ICTOT,ICCOR | |
15613 | RETURN | |
15614 | ENDIF | |
15615 | ||
15616 | IREJ = 0 | |
15617 | NITER = 100 | |
15618 | ITER = 0 | |
15619 | ICTOT = ICTOT+ISTR | |
15620 | IF(ISWMDL(7).EQ.-1) RETURN | |
15621 | C debug /POSTRG/ | |
15622 | IF(IDEB(42).GE.25) CALL PHO_PRSTRG | |
15623 | ||
15624 | ITOUCH = 0 | |
15625 | 50 CONTINUE | |
15626 | ITER = ITER+1 | |
15627 | IF(ITER.GE.NITER) THEN | |
15628 | IREJ = 1 | |
15629 | IF(IDEB(42).GE.2) THEN | |
15630 | WRITE(LO,'(1X,A,2I5)') 'PHO_MASCOR: rejection',ITER,NITER | |
15631 | IF(IDEB(42).GE.10) CALL PHO_PREVNT(0) | |
15632 | ENDIF | |
15633 | RETURN | |
15634 | ENDIF | |
15635 | ||
15636 | C check mass limits | |
15637 | IF(DT_RNDM(CMASS0).LT.0.5D0) THEN | |
15638 | IM1 = 1 | |
15639 | IM2 = ISTR | |
15640 | IST = 1 | |
15641 | ELSE | |
15642 | IM1 = ISTR | |
15643 | IM2 = 1 | |
15644 | IST = -1 | |
15645 | ENDIF | |
15646 | DO 100 I=IM1,IM2,IST | |
15647 | J1 = NPOS(1,I) | |
15648 | CMASS0 = PHEP(5,J1) | |
15649 | C get masses | |
15650 | IF(NCODE(I).EQ.3) THEN | |
15651 | CALL PHO_MEMASS(IPAR1(I),IPAR2(I),AM1,AM2,AM3,AM4,IP1,IP2) | |
15652 | ELSE IF((NCODE(I).EQ.4).OR.(NCODE(I).EQ.6)) THEN | |
15653 | CALL PHO_BAMASS(IPAR1(I),IPAR2(I),IPAR3(I), | |
15654 | & AM1,AM2,AM3,AM4,IP1,IP2) | |
15655 | ELSE IF(NCODE(I).EQ.5) THEN | |
15656 | CALL PHO_DQMASS(IPAR1(I),IPAR2(I),IPAR3(I),IPAR4(I), | |
15657 | & AM1,AM2) | |
15658 | AM3 = 0.D0 | |
15659 | AM4 = 0.D0 | |
15660 | IP1 = 0 | |
15661 | IP2 = 0 | |
15662 | ELSE IF(NCODE(I).EQ.7) THEN | |
15663 | AM1 = 0.15D0 | |
15664 | AM2 = 0.3D0 | |
15665 | AM3 = 0.765D0 | |
15666 | AM4 = 1.5D0 | |
15667 | *?????????????????????????????????? | |
15668 | IP1 = 23 | |
15669 | IP2 = 33 | |
15670 | *?????????????????????????????????? | |
15671 | ELSE IF(NCODE(I).LT.0) THEN | |
15672 | GOTO 90 | |
15673 | ELSE | |
15674 | WRITE(LO,'(/,1X,A,2I5)') 'PHO_MASCOR:ERROR: string no,NCODE ', | |
15675 | & J1,NCODE(I) | |
15676 | CALL PHO_ABORT | |
15677 | ENDIF | |
15678 | IF(IDEB(42).GE.20) WRITE(LO,'(1X,A,/3X,I3,5E11.3,2I5)') | |
15679 | & 'PHO_MASCOR: string no CHMASS,AM1,AM2,AM3,AM4,IP1,IP2:', | |
15680 | & I,CMASS0,AM1,AM2,AM3,AM4,IP1,IP2 | |
15681 | C select masses to correct | |
15682 | IBHAD(I) = 0 | |
15683 | NNCH(I) = 0 | |
15684 | C correction needed? | |
15685 | C no resonances for diquark-antidiquark and gluon-gluon strings | |
15686 | IF(NCODE(I).EQ.5) THEN | |
15687 | IF(CMASS0.LT.1.3D0*AM1) THEN | |
15688 | IF(ISWMDL(7).LE.2) THEN | |
15689 | IBHAD(I) = 90 | |
15690 | NNCH(I) = -1 | |
15691 | CHMASS = AM1*1.3D0 | |
15692 | ELSE | |
15693 | IREJ = 1 | |
15694 | RETURN | |
15695 | ENDIF | |
15696 | ENDIF | |
15697 | ELSE | |
15698 | INEED = 0 | |
15699 | C resonances possible | |
15700 | IF(ISWMDL(7).EQ.0) THEN | |
15701 | IF(CMASS0.LT.AM1*0.99D0) THEN | |
15702 | IBHAD(I) = IP1 | |
15703 | NNCH(I) = -1 | |
15704 | CHMASS = AM1 | |
15705 | INEED = 1 | |
15706 | ELSE IF(CMASS0.LT.MIN(AM2,AM4)*1.2D0) THEN | |
15707 | DELM1 = 1.D0/((CMASS0-AM1)**2+EPS) | |
15708 | DELM2 = 1.D0/((CMASS0-AM3)**2+EPS) | |
15709 | IF(DT_RNDM(DELM1).LT.DELM1/(DELM1+DELM2)) THEN | |
15710 | IBHAD(I) = IP1 | |
15711 | NNCH(I) = -1 | |
15712 | CHMASS = AM1 | |
15713 | ELSE | |
15714 | IBHAD(I) = IP2 | |
15715 | NNCH(I) = 1 | |
15716 | CHMASS = AM3 | |
15717 | ENDIF | |
15718 | ENDIF | |
15719 | ELSE IF((ISWMDL(7).EQ.1).OR.(ISWMDL(7).EQ.2)) THEN | |
15720 | IF(CMASS0.LT.AM1*0.99) THEN | |
15721 | IBHAD(I) = IP1 | |
15722 | NNCH(I) = -1 | |
15723 | CHMASS = AM1 | |
15724 | INEED = 1 | |
15725 | ENDIF | |
15726 | ELSE IF(ISWMDL(7).EQ.3) THEN | |
15727 | IF(CMASS0.LT.AM1) THEN | |
15728 | IREJ = 1 | |
15729 | RETURN | |
15730 | ENDIF | |
15731 | ELSE | |
15732 | WRITE(LO,'(/1X,A,I5)') | |
15733 | & 'PHO_MASCOR:ERROR:UNSUPPORTED ISWMDL(7)',ISWMDL(7) | |
15734 | CALL PHO_ABORT | |
15735 | ENDIF | |
15736 | ENDIF | |
15737 | C | |
15738 | C correction necessary? | |
15739 | IF(IBHAD(I).NE.0) THEN | |
15740 | C find largest invar. mass | |
15741 | IPOS = 0 | |
15742 | CMASS1 = -1.D0 | |
15743 | DO 200 J2=NHEP,3,-1 | |
15744 | IF(ABS(ISTHEP(J2)).EQ.1) THEN | |
15745 | IF((IPHIST(1,J2).LE.0).OR.(IPHIST(1,J2).GT.ISTR)) THEN | |
15746 | WRITE(LO,'(1X,2A,I7,I12)') 'PHO_MASCOR: ', | |
15747 | & 'inconsistent IPHIST(1,J2) entry (J2,KEV):',J2,KEVENT | |
15748 | CALL PHO_PREVNT(0) | |
15749 | ELSE IF(NCODE(IPHIST(1,J2)).GT.0) THEN | |
15750 | CMASS2= (PHEP(4,J1)+PHEP(4,J2))**2 | |
15751 | & -(PHEP(1,J1)+PHEP(1,J2))**2 | |
15752 | & -(PHEP(2,J1)+PHEP(2,J2))**2 | |
15753 | & -(PHEP(3,J1)+PHEP(3,J2))**2 | |
15754 | IF(CMASS2.GT.CMASS1) THEN | |
15755 | IPOS=J2 | |
15756 | CMASS1=CMASS2 | |
15757 | ENDIF | |
15758 | ENDIF | |
15759 | ENDIF | |
15760 | 200 CONTINUE | |
15761 | J2 = IPOS | |
15762 | IF((J1.EQ.J2).OR.(CMASS1.LE.EMIN)) THEN | |
15763 | IF(INEED.EQ.1) THEN | |
15764 | IREJ = 1 | |
15765 | RETURN | |
15766 | ELSE | |
15767 | IBHAD(I) = 0 | |
15768 | NNCH(I) = 0 | |
15769 | GOTO 90 | |
15770 | ENDIF | |
15771 | ENDIF | |
15772 | ISTA = ISTHEP(J1) | |
15773 | ISTB = ISTHEP(J2) | |
15774 | CMASS1 = SQRT(CMASS1) | |
15775 | CMASS2 = PHEP(5,J2) | |
15776 | IF(CMASS1.LT.(CMASS2+CHMASS)) CMASS2 = CMASS1-1.1D0*CHMASS | |
15777 | IREJ = 1 | |
15778 | IF(CMASS2.GT.0.D0) CALL PHO_MSHELL(PHEP(1,J1),PHEP(1,J2), | |
15779 | & CHMASS,CMASS2,PC1,PC2,IREJ) | |
15780 | IF(IREJ.NE.0) THEN | |
15781 | IFAIL(24) = IFAIL(24)+1 | |
15782 | IF(IDEB(42).GE.2) THEN | |
15783 | WRITE(LO,'(1X,A,2I4)') | |
15784 | & 'PHO_MASCOR: rejection by PHO_MSHELL (J1,J2):',J1,J2 | |
15785 | IF(IDEB(42).GE.10) CALL PHO_PREVNT(0) | |
15786 | ENDIF | |
15787 | IREJ = 1 | |
15788 | RETURN | |
15789 | ENDIF | |
15790 | C momentum transfer | |
15791 | DO 210 II=1,4 | |
15792 | PTR(II) = PHEP(II,J2)-PC2(II) | |
15793 | 210 CONTINUE | |
15794 | IF(IDEB(42).GE.10) WRITE(LO,'(1X,A,/5X,2I3,4E12.3)') | |
15795 | & 'PHO_MASCOR: J1,J2,transfer',J1,J2,PTR | |
15796 | C copy parents of strings | |
15797 | C register partons belonging to first string | |
15798 | IF(IDHEP(J1).EQ.90) THEN | |
15799 | K1 = JMOHEP(1,J1) | |
15800 | K2 = MAX(JMOHEP(1,J1),-JMOHEP(2,J1)) | |
15801 | ESUM = 0.D0 | |
15802 | DO 500 II=K1,K2 | |
15803 | ESUM = ESUM+PHEP(4,II) | |
15804 | 500 CONTINUE | |
15805 | IF(JMOHEP(2,J1).GT.0) ESUM = ESUM+PHEP(4,JMOHEP(2,J1)) | |
15806 | DO 600 II=K1,K2 | |
15807 | FAC = PHEP(4,II)/ESUM | |
15808 | DO 650 K=1,4 | |
15809 | P1(K) = PHEP(K,II)+FAC*PTR(K) | |
15810 | 650 CONTINUE | |
15811 | CALL PHO_REGPAR(-1,IDHEP(II),0,J1,J2,P1(1),P1(2),P1(3), | |
15812 | & P1(4),IPHIST(1,II),IPHIST(2,II),ICOLOR(1,II), | |
15813 | & ICOLOR(2,II),IPOS,1) | |
15814 | 600 CONTINUE | |
15815 | K1A = IPOS+K1-K2 | |
15816 | IF(JMOHEP(2,J1).GT.0) THEN | |
15817 | II = JMOHEP(2,J1) | |
15818 | FAC = PHEP(4,II)/ESUM | |
15819 | DO 675 K=1,4 | |
15820 | P1(K) = PHEP(K,II)+FAC*PTR(K) | |
15821 | 675 CONTINUE | |
15822 | CALL PHO_REGPAR(-1,IDHEP(II),0,J1,J2,P1(1),P1(2),P1(3), | |
15823 | & P1(4),IPHIST(1,II),IPHIST(2,II),ICOLOR(1,II), | |
15824 | & ICOLOR(2,II),IPOS,1) | |
15825 | ENDIF | |
15826 | K2A = -IPOS | |
15827 | ELSE | |
15828 | K1A = J1 | |
15829 | K2A = J2 | |
15830 | ENDIF | |
15831 | C register partons belonging to second string | |
15832 | IF(IDHEP(J2).EQ.90) THEN | |
15833 | CALL PHO_GETLTR(PHEP(1,J2),PC2,GAM,GAMB,DELE,IREJL) | |
15834 | K1 = JMOHEP(1,J2) | |
15835 | K2 = MAX(JMOHEP(1,J2),-JMOHEP(2,J2)) | |
15836 | ESUM = 0.D0 | |
15837 | DO 300 II=K1,K2 | |
15838 | ESUM = ESUM+PHEP(4,II) | |
15839 | 300 CONTINUE | |
15840 | IF(JMOHEP(2,J2).GT.0) ESUM = ESUM+PHEP(4,JMOHEP(2,J2)) | |
15841 | DO 400 II=K1,K2 | |
15842 | **sr 28.12.2006 fix adopted from FLUKA | |
15843 | C FAC = PHEP(4,II)/ESUM | |
15844 | IF (ABS(ESUM).GT.0.D0) THEN | |
15845 | FAC = PHEP(4,II)/ESUM | |
15846 | ELSE | |
15847 | FAC = 1.0D0 | |
15848 | ENDIF | |
15849 | ** | |
15850 | IF(IREJL.EQ.0) THEN | |
15851 | CALL PHO_MKSLTR(PHEP(1,II),P1,GAM,GAMB) | |
15852 | P1(4) = P1(4)+FAC*DELE | |
15853 | ELSE | |
15854 | DO 450 K=1,4 | |
15855 | P1(K) = PHEP(K,II)-FAC*PTR(K) | |
15856 | 450 CONTINUE | |
15857 | ENDIF | |
15858 | CALL PHO_REGPAR(-1,IDHEP(II),0,J1,J2,P1(1),P1(2),P1(3), | |
15859 | & P1(4),IPHIST(1,II),IPHIST(2,II),ICOLOR(1,II), | |
15860 | & ICOLOR(2,II),IPOS,1) | |
15861 | 400 CONTINUE | |
15862 | K1B = IPOS+K1-K2 | |
15863 | IF(JMOHEP(2,J2).GT.0) THEN | |
15864 | II = JMOHEP(2,J2) | |
15865 | FAC = PHEP(4,II)/ESUM | |
15866 | IF(IREJL.EQ.0) THEN | |
15867 | CALL PHO_MKSLTR(PHEP(1,II),P1,GAM,GAMB) | |
15868 | P1(4) = P1(4)+FAC*DELE | |
15869 | ELSE | |
15870 | DO 475 K=1,4 | |
15871 | P1(K) = PHEP(K,II)-FAC*PTR(K) | |
15872 | 475 CONTINUE | |
15873 | ENDIF | |
15874 | CALL PHO_REGPAR(-1,IDHEP(II),0,J1,J2,P1(1),P1(2),P1(3), | |
15875 | & P1(4),IPHIST(1,II),IPHIST(2,II),ICOLOR(1,II), | |
15876 | & ICOLOR(2,II),IPOS,1) | |
15877 | ENDIF | |
15878 | K2B = -IPOS | |
15879 | ELSE | |
15880 | K1B = J1 | |
15881 | K2B = J2 | |
15882 | ENDIF | |
15883 | C register first string/collapsed to hadron | |
15884 | IF((ISWMDL(7).EQ.0).OR.(ISWMDL(7).EQ.1)) THEN | |
15885 | IF(NCODE(I).NE.5) THEN | |
15886 | CALL PHO_REGPAR(1,0,IBHAD(I),K1A,K2A,PC1(1),PC1(2),PC1(3), | |
15887 | & PC1(4),IPHIST(1,J1),IPHIST(2,J1),0,0,IPOS,1) | |
15888 | C label string as collapsed to hadron/resonance | |
15889 | NCODE(I) = -99 | |
15890 | IDHEP(J1) = 92 | |
15891 | ELSE | |
15892 | CALL PHO_REGPAR(-1,90,0,K1A,K2A,PC1(1),PC1(2),PC1(3), | |
15893 | & PC1(4),IPHIST(1,J1),IPHIST(2,J1),0,0,IPOS,1) | |
15894 | IDHEP(J1) = 91 | |
15895 | ENDIF | |
15896 | NPOS(1,I) = IPOS | |
15897 | NPOS(2,I) = K1A | |
15898 | NPOS(3,I) = K2A | |
15899 | ELSE | |
15900 | CALL PHO_REGPAR(ISTA,IDHEP(J1),IMPART(J1),K1A,K2A,PC1(1), | |
15901 | & PC1(2),PC1(3),PC1(4),IPHIST(1,J1),IPHIST(2,J1), | |
15902 | & ICOLOR(1,J1),ICOLOR(2,J1),IPOS,1) | |
15903 | IF(IDHEP(J1).EQ.90) THEN | |
15904 | NPOS(1,IPHIST(1,J1)) = IPOS | |
15905 | NPOS(2,IPHIST(1,J1)) = K1A | |
15906 | NPOS(3,IPHIST(1,J1)) = K2A | |
15907 | C label string as collapsed to resonance-string | |
15908 | IDHEP(J1) = 91 | |
15909 | ELSE IF((IPHIST(1,J1).GE.1).AND.(IPHIST(1,J1).LE.ISTR)) THEN | |
15910 | IF(NPOS(1,IPHIST(1,J1)).EQ.J1) NPOS(1,IPHIST(1,J1))=IPOS | |
15911 | ENDIF | |
15912 | ENDIF | |
15913 | C register second string/hadron/parton | |
15914 | CALL PHO_REGPAR(ISTB,IDHEP(J2),IMPART(J2),K1B,K2B,PC2(1), | |
15915 | & PC2(2),PC2(3),PC2(4),IPHIST(1,J2),IPHIST(2,J2),ICOLOR(1,J2), | |
15916 | & ICOLOR(2,J2),IPOS,1) | |
15917 | IF(IDHEP(J2).EQ.90) THEN | |
15918 | NPOS(1,IPHIST(1,J2))=IPOS | |
15919 | NPOS(2,IPHIST(1,J2))=K1B | |
15920 | NPOS(3,IPHIST(1,J2))=K2B | |
15921 | C label string touched by momentum transfer | |
15922 | IDHEP(J2) = 91 | |
15923 | ELSE IF((IPHIST(1,J2).GE.1).AND.(IPHIST(1,J2).LE.ISTR)) THEN | |
15924 | IF(NPOS(1,IPHIST(1,J2)).EQ.J2) NPOS(1,IPHIST(1,J2))=IPOS | |
15925 | ENDIF | |
15926 | ICCOR = ICCOR+1 | |
15927 | ITOUCH = ITOUCH+1 | |
15928 | C consistency checks | |
15929 | IF(IDEB(42).GE.5) THEN | |
15930 | CALL PHO_CHECK(-1,IDEV) | |
15931 | IF(IDEB(42).GE.25) CALL PHO_PREVNT(0) | |
15932 | ENDIF | |
15933 | C jump to next iteration | |
15934 | GOTO 50 | |
15935 | ENDIF | |
15936 | 90 CONTINUE | |
15937 | 100 CONTINUE | |
15938 | C debug output | |
15939 | IF(IDEB(42).GE.15) THEN | |
15940 | IF((ITOUCH.GT.0).OR.(IDEB(42).GE.25)) THEN | |
15941 | WRITE(LO,'(1X,A,I5)') 'PHO_MASCOR: iterations:',ITER | |
15942 | CALL PHO_PREVNT(1) | |
15943 | ENDIF | |
15944 | ENDIF | |
15945 | END | |
15946 | ||
15947 | *$ CREATE PHO_PARCOR.FOR | |
15948 | *COPY PHO_PARCOR | |
15949 | CDECK ID>, PHO_PARCOR | |
15950 | SUBROUTINE PHO_PARCOR(MODE,IREJ) | |
15951 | C******************************************************************** | |
15952 | C | |
15953 | C conversion of string partons (using JETSET masses) | |
15954 | C | |
15955 | C input: MODE >0 position index of corresponding string | |
15956 | C -1 initialization | |
15957 | C -2 output of statistics | |
15958 | C | |
15959 | C output: /POSTRG/ | |
15960 | C IREJ 1 combination of strings impossible | |
15961 | C 0 successful combination | |
15962 | C | |
15963 | C******************************************************************** | |
15964 | IMPLICIT DOUBLE PRECISION (A-H,O-Z) | |
15965 | SAVE | |
15966 | ||
15967 | PARAMETER ( DELM = 0.005D0, | |
15968 | & DEPS = 1.D-15, | |
15969 | & EPS = 1.D-5) | |
15970 | ||
15971 | C input/output channels | |
15972 | INTEGER LI,LO | |
15973 | COMMON /POINOU/ LI,LO | |
15974 | C event debugging information | |
15975 | INTEGER NMAXD | |
15976 | PARAMETER (NMAXD=100) | |
15977 | INTEGER IDEB,KSPOM,KHPOM,KSREG,KHDIR,KACCEP,KSTRG,KHTRG,KSLOO, | |
15978 | & KHLOO,KSDPO,KHDPO,KEVENT,KSOFT,KHARD | |
15979 | COMMON /PODEBG/ IDEB(NMAXD),KSPOM,KHPOM,KSREG,KHDIR,KACCEP,KSTRG, | |
15980 | & KHTRG,KSLOO,KHLOO,KSDPO,KHDPO,KEVENT,KSOFT,KHARD | |
15981 | C internal rejection counters | |
15982 | INTEGER NMXJ | |
15983 | PARAMETER (NMXJ=60) | |
15984 | CHARACTER*10 REJTIT | |
15985 | INTEGER IFAIL | |
15986 | COMMON /POLOOP/ IFAIL(NMXJ),REJTIT(NMXJ) | |
15987 | C model switches and parameters | |
15988 | CHARACTER*8 MDLNA | |
15989 | INTEGER ISWMDL,IPAMDL | |
15990 | DOUBLE PRECISION PARMDL | |
15991 | COMMON /POMDLS/ MDLNA(50),ISWMDL(50),PARMDL(400),IPAMDL(400) | |
15992 | C standard particle data interface | |
15993 | INTEGER NMXHEP | |
15994 | PARAMETER (NMXHEP=4000) | |
15995 | INTEGER NEVHEP,NHEP,ISTHEP,IDHEP,JMOHEP,JDAHEP | |
15996 | DOUBLE PRECISION PHEP,VHEP | |
15997 | COMMON /POEVT1/ NEVHEP,NHEP,ISTHEP(NMXHEP),IDHEP(NMXHEP), | |
15998 | & JMOHEP(2,NMXHEP),JDAHEP(2,NMXHEP),PHEP(5,NMXHEP), | |
15999 | & VHEP(4,NMXHEP) | |
16000 | C extension to standard particle data interface (PHOJET specific) | |
16001 | INTEGER IMPART,IPHIST,ICOLOR | |
16002 | COMMON /POEVT2/ IMPART(NMXHEP),IPHIST(2,NMXHEP),ICOLOR(2,NMXHEP) | |
16003 | C color string configurations including collapsed strings and hadrons | |
16004 | INTEGER MSTR | |
16005 | PARAMETER (MSTR=500) | |
16006 | INTEGER NPOS,NCODE,IPAR1,IPAR2,IPAR3,IPAR4,NNCH,IBHAD | |
16007 | COMMON /POSTRG/ NPOS(4,MSTR),NCODE(MSTR), | |
16008 | & IPAR1(MSTR),IPAR2(MSTR),IPAR3(MSTR),IPAR4(MSTR), | |
16009 | & NNCH(MSTR),IBHAD(MSTR),ISTR | |
16010 | ||
16011 | DIMENSION PP1(4),PP2(4),PB1(4),PB2(4),GAM(3),GAMB(3), | |
16012 | & PL(4,100),XMP(100),XML(100) | |
16013 | ||
16014 | DOUBLE PRECISION PYMASS | |
16015 | ||
16016 | IREJ = 0 | |
16017 | IMODE = MODE | |
16018 | C | |
16019 | IF(IMODE.GT.0) THEN | |
16020 | ICH = 0 | |
16021 | I1 = JMOHEP(1,IMODE) | |
16022 | I2 = ABS(JMOHEP(2,IMODE)) | |
16023 | C copy to local field | |
16024 | L = 0 | |
16025 | DO 100 I=I1,I2 | |
16026 | L = L+1 | |
16027 | DO 200 K=1,4 | |
16028 | PL(K,L) = PHEP(K,I) | |
16029 | 200 CONTINUE | |
16030 | XMP(L) = PHEP(5,I) | |
16031 | XML(L) = PYMASS(IDHEP(I)) | |
16032 | 100 CONTINUE | |
16033 | IPAR = L | |
16034 | XMC = PHEP(5,IMODE) | |
16035 | IF(IDEB(82).GE.20) THEN | |
16036 | WRITE(LO,'(1X,A,I7,2I4)') | |
16037 | & 'PHO_PARCOR: ini.momenta,masses(C/L),EV,ICH,L', | |
16038 | & KEVENT,IMODE,L | |
16039 | DO 150 I=1,L | |
16040 | WRITE(LO,'(1X,4E12.4,2X,2E12.4)') (PL(K,I),K=1,4), | |
16041 | & XMP(I),XML(I) | |
16042 | 150 CONTINUE | |
16043 | ENDIF | |
16044 | C | |
16045 | C two parton configurations | |
16046 | C ----------------------------------------- | |
16047 | IF(IPAR.EQ.2) THEN | |
16048 | XM1 = XML(1) | |
16049 | XM2 = XML(2) | |
16050 | IF((XM1+XM2).GE.XMC) THEN | |
16051 | IF(IDEB(82).GE.6) WRITE(LO,'(1X,A,/,5X,I3,3E12.4)') | |
16052 | & 'PHO_PARCOR: REJECTION I,XM1,XM2,XMC', | |
16053 | & IMODE,XM1,XM2,XMC | |
16054 | GOTO 990 | |
16055 | ENDIF | |
16056 | C conversion possible | |
16057 | CALL PHO_MSHELL(PL(1,1),PL(1,2),XM1,XM2,PP1,PP2,IREJ) | |
16058 | IF(IREJ.NE.0) THEN | |
16059 | IFAIL(36) = IFAIL(36)+1 | |
16060 | IF(IDEB(82).GE.6) WRITE(LO,'(1X,A,I8,I4,E12.4)') | |
16061 | & 'PHO_PARCOR: rejection by PHO_MSHELL EV,STRING,MASS', | |
16062 | & KEVENT,IMODE,XMC | |
16063 | GOTO 990 | |
16064 | ENDIF | |
16065 | ICH = 1 | |
16066 | DO 115 K=1,4 | |
16067 | PL(K,1) = PP1(K) | |
16068 | PL(K,2) = PP2(K) | |
16069 | XMP(1) = XM1 | |
16070 | XMP(2) = XM2 | |
16071 | 115 CONTINUE | |
16072 | C | |
16073 | C multi parton configurations | |
16074 | C --------------------------------- | |
16075 | ELSE | |
16076 | C | |
16077 | C random selection of string side to start with | |
16078 | IF(DT_RNDM(XMC).LT.0.5D0) THEN | |
16079 | K1 = 1 | |
16080 | K2 = IPAR | |
16081 | KS = 1 | |
16082 | ELSE | |
16083 | K1 = IPAR | |
16084 | K2 = 1 | |
16085 | KS = -1 | |
16086 | ENDIF | |
16087 | ITER = 0 | |
16088 | C | |
16089 | 300 CONTINUE | |
16090 | IF(ITER.LT.4) THEN | |
16091 | KK = K1 | |
16092 | K1 = K2 | |
16093 | K2 = KK | |
16094 | KS = -KS | |
16095 | ELSE | |
16096 | GOTO 990 | |
16097 | ENDIF | |
16098 | ITER = ITER+1 | |
16099 | C select method | |
16100 | IF(ITER.GT.2) GOTO 230 | |
16101 | ||
16102 | C conversion according to color flow method | |
16103 | IFAI = 0 | |
16104 | DO 210 II=K1,K2-KS,KS | |
16105 | DO 215 IK=II+KS,K2,KS | |
16106 | XM1 = XML(II) | |
16107 | XM2 = XML(IK) | |
16108 | * IF(IDEB(82).GE.10) WRITE(LO,'(1X,A,2I3,4E12.4)') | |
16109 | * & 'PHO_PARCOR:I,K,XM(1-4)',II,IK,XM1,XMP(II),XM2,XMP(IK) | |
16110 | IF((ABS(XM1-XMP(II)).GT.DELM) | |
16111 | & .OR.(ABS(XM2-XMP(IK)).GT.DELM)) THEN | |
16112 | CALL PHO_MSHELL(PL(1,II),PL(1,IK),XM1,XM2,PP1,PP2,IREJ) | |
16113 | IF(IREJ.NE.0) THEN | |
16114 | IFAIL(36) = IFAIL(36)+1 | |
16115 | IF(IDEB(82).GE.6) WRITE(LO,'(1X,2A,I8,3I4)') | |
16116 | & 'PHO_PARCOR: ', | |
16117 | & 'int.rej. by PHO_MSHELL EV,IC,I1,I2', | |
16118 | & KEVENT,IMODE,II,IK | |
16119 | IREJ = 0 | |
16120 | ELSE | |
16121 | ICH = ICH+1 | |
16122 | DO 220 KK=1,4 | |
16123 | PL(KK,II) = PP1(KK) | |
16124 | PL(KK,IK) = PP2(KK) | |
16125 | 220 CONTINUE | |
16126 | XMP(II) = XM1 | |
16127 | XMP(IK) = XM2 | |
16128 | GOTO 219 | |
16129 | ENDIF | |
16130 | ELSE | |
16131 | GOTO 219 | |
16132 | ENDIF | |
16133 | 215 CONTINUE | |
16134 | IFAI = II | |
16135 | 219 CONTINUE | |
16136 | 210 CONTINUE | |
16137 | IF(IFAI.NE.0) GOTO 300 | |
16138 | GOTO 950 | |
16139 | C | |
16140 | 230 CONTINUE | |
16141 | C | |
16142 | C conversion according to remainder method | |
16143 | DO 350 I=K1,K2,KS | |
16144 | XM1 = XML(I) | |
16145 | IF(ABS(XM1-XMP(I)).GT.DELM) THEN | |
16146 | ICH = ICH+1 | |
16147 | IFAI = I | |
16148 | C conversion necessary | |
16149 | DO 400 K=1,4 | |
16150 | PB1(K) = PL(K,I) | |
16151 | PB2(K) = PHEP(K,IMODE)-PB1(K) | |
16152 | 400 CONTINUE | |
16153 | XM2 = PB2(4)**2-PB2(1)**2-PB2(2)**2-PB2(3)**2 | |
16154 | IF(XM2.LT.0.D0) THEN | |
16155 | IF(IDEB(82).GE.10) WRITE(LO,'(1X,2A,/,5X,3I3,4E12.4)') | |
16156 | & 'PHO_PARCOR: ', | |
16157 | & 'int.rej. I,IPA,ICH,XML,XMP,XM2**2,MCHAIN', | |
16158 | & I,IPAR,IMODE,XM1,XMP(I),XM2,XMC | |
16159 | GOTO 300 | |
16160 | ENDIF | |
16161 | XM2 = SQRT(XM2) | |
16162 | IF((XM1+XM2).GE.XMC) THEN | |
16163 | IF(IDEB(82).GE.10) WRITE(LO,'(1X,2A,/,5X,3I3,4E12.4)') | |
16164 | & 'PHO_PARCOR: ', | |
16165 | & 'int.rej. I,IPA,ICH,XML,XMP,XM2,XMC', | |
16166 | & I,IPAR,IMODE,XM1,XMP(I),XM2,XMC | |
16167 | GOTO 300 | |
16168 | ENDIF | |
16169 | C conversion possible | |
16170 | CALL PHO_MSHELL(PB1,PB2,XM1,XM2,PP1,PP2,IREJ) | |
16171 | IF(IREJ.NE.0) THEN | |
16172 | IFAIL(36) = IFAIL(36)+1 | |
16173 | IF(IDEB(82).GE.6) WRITE(LO,'(1X,A,I8,3I4)') | |
16174 | & 'PHO_PARCOR: PHO_MSHELL rej. ITER,STRING,PARTON', | |
16175 | & ITER,IMODE,I | |
16176 | GOTO 300 | |
16177 | ENDIF | |
16178 | C calculate Lorentz transformation | |
16179 | CALL PHO_GETLTR(PB2,PP2,GAM,GAMB,DELE,IREJ) | |
16180 | IF(IREJ.NE.0) THEN | |
16181 | IF(IDEB(82).GE.6) WRITE(LO,'(1X,A,I8,3I4)') | |
16182 | & 'PHO_PARCOR: PHO_GETLTR rej. ITER,STRING,PARTON', | |
16183 | & ITER,IMODE,I | |
16184 | GOTO 300 | |
16185 | ENDIF | |
16186 | IFAI = 0 | |
16187 | C transform remaining partons | |
16188 | DO 450 L=K1,K2,KS | |
16189 | IF(L.NE.I) THEN | |
16190 | CALL PHO_MKSLTR(PL(1,L),PP2,GAM,GAMB) | |
16191 | DO 500 K=1,4 | |
16192 | PL(K,L) = PP2(K) | |
16193 | 500 CONTINUE | |
16194 | ELSE | |
16195 | DO 550 K=1,4 | |
16196 | PL(K,L) = PP1(K) | |
16197 | 550 CONTINUE | |
16198 | ENDIF | |
16199 | 450 CONTINUE | |
16200 | XMP(I) = XM1 | |
16201 | ENDIF | |
16202 | 350 CONTINUE | |
16203 | ENDIF | |
16204 | ||
16205 | C register transformed partons | |
16206 | 950 CONTINUE | |
16207 | IREJ = 0 | |
16208 | IF(ICH.NE.0) THEN | |
16209 | IP1 = NHEP+1 | |
16210 | L = 0 | |
16211 | DO 700 I=I1,I2 | |
16212 | L= L+1 | |
16213 | CALL PHO_REGPAR(-1,IDHEP(I),0,IMODE,0,PL(1,L),PL(2,L), | |
16214 | & PL(3,L),PL(4,L),IPHIST(1,I),IPHIST(2,I),ICOLOR(1,I), | |
16215 | & ICOLOR(2,I),IPOS,1) | |
16216 | 700 CONTINUE | |
16217 | IP2 = IPOS | |
16218 | C register string | |
16219 | CALL PHO_REGPAR(-1,90,0,IP1,-IP2,PHEP(1,IMODE), | |
16220 | & PHEP(2,IMODE),PHEP(3,IMODE),PHEP(4,IMODE),IPHIST(1,IMODE), | |
16221 | & IPHIST(2,IMODE),ICOLOR(1,IMODE),ICOLOR(2,IMODE),IPOS,1) | |
16222 | C update /POSTRG/ | |
16223 | I = IPHIST(1,IMODE) | |
16224 | NPOS(1,I) = IPOS | |
16225 | NPOS(2,I) = IP1 | |
16226 | NPOS(3,I) = -IP2 | |
16227 | ENDIF | |
16228 | C debug output | |
16229 | IF(IDEB(82).GE.20) THEN | |
16230 | WRITE(LO,'(1X,A,I7,2I4)') | |
16231 | & 'PHO_PARCOR: fin.momenta,masses(C/L),(EV,ICH,L)', | |
16232 | & KEVENT,IMODE,L | |
16233 | DO 850 I=1,L | |
16234 | WRITE(LO,'(1X,4E12.4,2X,2E12.4)') (PL(K,I),K=1,4), | |
16235 | & XMP(I),XML(I) | |
16236 | 850 CONTINUE | |
16237 | WRITE(LO,'(1X,A,2I5)') | |
16238 | & 'PHO_PARCOR: conversion done (old/new ICH)',IMODE,IPOS | |
16239 | ENDIF | |
16240 | RETURN | |
16241 | C rejection | |
16242 | 990 CONTINUE | |
16243 | IREJ = 1 | |
16244 | IF(IDEB(82).GE.3) THEN | |
16245 | WRITE(LO,'(/1X,A,/,5X,3I5,E12.4)') | |
16246 | & 'PHO_PARCOR: rejection I,IPAR,ICHAIN,MCHAIN', | |
16247 | & IFAI,IPAR,IMODE,XMC | |
16248 | IF(IDEB(82).GE.5) THEN | |
16249 | WRITE(LO,'(1X,A,I7,2I4)') | |
16250 | & 'PHO_PARCOR: momenta,masses(C/L),(EV,ICH,L)', | |
16251 | & KEVENT,IMODE,IPAR | |
16252 | DO 155 I=1,IPAR | |
16253 | WRITE(LO,'(1X,4E12.4,2X,2E12.4)') (PL(K,I),K=1,4), | |
16254 | & XMP(I),XML(I) | |
16255 | 155 CONTINUE | |
16256 | ENDIF | |
16257 | ENDIF | |
16258 | RETURN | |
16259 | ||
16260 | ELSE IF(IMODE.EQ.-1) THEN | |
16261 | C initialization | |
16262 | RETURN | |
16263 | ||
16264 | ELSE IF(IMODE.EQ.-2) THEN | |
16265 | C final output | |
16266 | RETURN | |
16267 | ENDIF | |
16268 | END | |
16269 | ||
16270 | *$ CREATE PHO_STRING.FOR | |
16271 | *COPY PHO_STRING | |
16272 | CDECK ID>, PHO_STRING | |
16273 | SUBROUTINE PHO_STRING(IMODE,IREJ) | |
16274 | C******************************************************************** | |
16275 | C | |
16276 | C calculation of string combinatorics, Lorentz boosts and | |
16277 | C particle codes | |
16278 | C | |
16279 | C - splitting of gluons | |
16280 | C - strings will be built up from pairs of partons | |
16281 | C according to their color labels | |
16282 | C with IDHEP(..) = -1 | |
16283 | C - there can be other particles between to string partons | |
16284 | C (these will be unchanged by string construction) | |
16285 | C - string mass fine correction | |
16286 | C | |
16287 | C input: IMODE 1 complete string processing | |
16288 | C -1 initialization | |
16289 | C -2 output of statistics | |
16290 | C | |
16291 | C output: /POSTRG/ | |
16292 | C IREJ 1 combination of strings impossible | |
16293 | C 0 successful combination | |
16294 | C 50 rejection due to user cutoffs | |
16295 | C | |
16296 | C******************************************************************** | |
16297 | IMPLICIT DOUBLE PRECISION (A-H,O-Z) | |
16298 | SAVE | |
16299 | ||
16300 | PARAMETER ( DEPS = 1.D-15, | |
16301 | & EPS = 1.D-5 ) | |
16302 | ||
16303 | C input/output channels | |
16304 | INTEGER LI,LO | |
16305 | COMMON /POINOU/ LI,LO | |
16306 | C event debugging information | |
16307 | INTEGER NMAXD | |
16308 | PARAMETER (NMAXD=100) | |
16309 | INTEGER IDEB,KSPOM,KHPOM,KSREG,KHDIR,KACCEP,KSTRG,KHTRG,KSLOO, | |
16310 | & KHLOO,KSDPO,KHDPO,KEVENT,KSOFT,KHARD | |
16311 | COMMON /PODEBG/ IDEB(NMAXD),KSPOM,KHPOM,KSREG,KHDIR,KACCEP,KSTRG, | |
16312 | & KHTRG,KSLOO,KHLOO,KSDPO,KHDPO,KEVENT,KSOFT,KHARD | |
16313 | C general process information | |
16314 | INTEGER IPROCE,IDNODF,IDIFR1,IDIFR2,IDDPOM,IPRON | |
16315 | COMMON /POPRCS/ IPROCE,IDNODF,IDIFR1,IDIFR2,IDDPOM,IPRON(15,4) | |
16316 | C internal rejection counters | |
16317 | INTEGER NMXJ | |
16318 | PARAMETER (NMXJ=60) | |
16319 | CHARACTER*10 REJTIT | |
16320 | INTEGER IFAIL | |
16321 | COMMON /POLOOP/ IFAIL(NMXJ),REJTIT(NMXJ) | |
16322 | C model switches and parameters | |
16323 | CHARACTER*8 MDLNA | |
16324 | INTEGER ISWMDL,IPAMDL | |
16325 | DOUBLE PRECISION PARMDL | |
16326 | COMMON /POMDLS/ MDLNA(50),ISWMDL(50),PARMDL(400),IPAMDL(400) | |
16327 | C hard cross sections and MC selection weights | |
16328 | INTEGER Max_pro_2 | |
16329 | PARAMETER ( Max_pro_2 = 16 ) | |
16330 | INTEGER IHa_last,IHb_last,MH_pro_on,MH_tried, | |
16331 | & MH_acc_1,MH_acc_2 | |
16332 | DOUBLE PRECISION Hfac,HWgx,HSig,Hdpt,HEcm_last,HQ2a_last,HQ2b_last | |
16333 | COMMON /POHRCS/ Hfac(-1:Max_pro_2),HWgx(-1:Max_pro_2), | |
16334 | & HSig(-1:Max_pro_2),Hdpt(-1:Max_pro_2), | |
16335 | & HEcm_last,HQ2a_last,HQ2b_last,IHa_last,IHb_last, | |
16336 | & MH_pro_on(-1:Max_pro_2,0:4),MH_tried(-1:Max_pro_2,0:4), | |
16337 | & MH_acc_1(-1:Max_pro_2,0:4),MH_acc_2(-1:Max_pro_2,0:4) | |
16338 | C standard particle data interface | |
16339 | INTEGER NMXHEP | |
16340 | PARAMETER (NMXHEP=4000) | |
16341 | INTEGER NEVHEP,NHEP,ISTHEP,IDHEP,JMOHEP,JDAHEP | |
16342 | DOUBLE PRECISION PHEP,VHEP | |
16343 | COMMON /POEVT1/ NEVHEP,NHEP,ISTHEP(NMXHEP),IDHEP(NMXHEP), | |
16344 | & JMOHEP(2,NMXHEP),JDAHEP(2,NMXHEP),PHEP(5,NMXHEP), | |
16345 | & VHEP(4,NMXHEP) | |
16346 | C extension to standard particle data interface (PHOJET specific) | |
16347 | INTEGER IMPART,IPHIST,ICOLOR | |
16348 | COMMON /POEVT2/ IMPART(NMXHEP),IPHIST(2,NMXHEP),ICOLOR(2,NMXHEP) | |
16349 | C color string configurations including collapsed strings and hadrons | |
16350 | INTEGER MSTR | |
16351 | PARAMETER (MSTR=500) | |
16352 | INTEGER NPOS,NCODE,IPAR1,IPAR2,IPAR3,IPAR4,NNCH,IBHAD | |
16353 | COMMON /POSTRG/ NPOS(4,MSTR),NCODE(MSTR), | |
16354 | & IPAR1(MSTR),IPAR2(MSTR),IPAR3(MSTR),IPAR4(MSTR), | |
16355 | & NNCH(MSTR),IBHAD(MSTR),ISTR | |
16356 | C table of particle indices for recursive PHOJET calls | |
16357 | INTEGER MAXIPX | |
16358 | PARAMETER ( MAXIPX = 100 ) | |
16359 | INTEGER IPOPOS,IPORES,IPOIX1,IPOIX2,IPOIX3 | |
16360 | COMMON /PORECU/ IPOPOS(2,MAXIPX),IPORES(MAXIPX), | |
16361 | & IPOIX1,IPOIX2,IPOIX3 | |
16362 | C some constants | |
16363 | DOUBLE PRECISION PI,PI2,PI4,GEV2MB,Q_ch,Q_ch2,Q_ch4 | |
16364 | COMMON /POCONS/ PI,PI2,PI4,GEV2MB, | |
16365 | & Q_ch(-6:6),Q_ch2(-6:6),Q_ch4(-6:6) | |
16366 | ||
16367 | IREJ = 0 | |
16368 | IF(IMODE.EQ.-1) THEN | |
16369 | CALL PHO_POMCOR(-1) | |
16370 | CALL PHO_MASCOR(-1) | |
16371 | CALL PHO_PARCOR(-1,IREJ) | |
16372 | RETURN | |
16373 | ELSE IF(IMODE.EQ.-2) THEN | |
16374 | CALL PHO_POMCOR(-2) | |
16375 | CALL PHO_MASCOR(-2) | |
16376 | CALL PHO_PARCOR(-2,IREJ) | |
16377 | RETURN | |
16378 | ENDIF | |
16379 | ||
16380 | C generate enhanced graphs | |
16381 | IF(IPOIX2.GT.0) THEN | |
16382 | 200 CONTINUE | |
16383 | I1 = MAX(1,IPOIX1) | |
16384 | I2 = IPOIX2 | |
16385 | IF(ISWMDL(14).EQ.1) IPOIX1 = 0 | |
16386 | KSPOMS = KSPOM-1 | |
16387 | KSREGS = KSREG | |
16388 | KHPOMS = KHPOM | |
16389 | KHDIRS = KHDIR | |
16390 | IDDFS1 = IDIFR1 | |
16391 | IDDFS2 = IDIFR2 | |
16392 | IDDPOS = IDDPOM | |
16393 | DO 110 I=I1,I2 | |
16394 | IPOIX3 = I | |
16395 | KSPOM = 0 | |
16396 | KSREG = 0 | |
16397 | KHPOM = 0 | |
16398 | KHDIR = 0 | |
16399 | IF(IPORES(I).EQ.8) THEN | |
16400 | KSPOM = 2 | |
16401 | LSPOM = 2 | |
16402 | LHPOM = 0 | |
16403 | LSREG = 0 | |
16404 | LHDIR = 0 | |
16405 | IGEN = abs(IPHIST(2,IPOPOS(1,I))) | |
16406 | CALL PHO_STDPAR(IPOPOS(1,I),IPOPOS(2,I),IGEN, | |
16407 | & LSPOM,LSREG,LHPOM,LHDIR,IREJ) | |
16408 | IF(IREJ.NE.0) THEN | |
16409 | IF(IDEB(4).GE.2) THEN | |
16410 | WRITE(LO,'(/1X,A,I5)') | |
16411 | & 'PHO_STRING: sec.rejection by PHO_STDPAR',IREJ | |
16412 | CALL PHO_PREVNT(-1) | |
16413 | ENDIF | |
16414 | RETURN | |
16415 | ENDIF | |
16416 | KSPOM = KSPOMS+LSPOM | |
16417 | KSREG = KSREGS+LSREG | |
16418 | KHPOM = KHPOMS+LHPOM | |
16419 | KHDIR = KHDIRS+LHDIR | |
16420 | ELSE IF(IPORES(I).EQ.4) THEN | |
16421 | ITEMP = ISWMDL(17) | |
16422 | ISWMDL(17) = 0 | |
16423 | CALL PHO_CDIFF(IPOPOS(1,I),IPOPOS(2,I),MSOFT,MHARD,1,IREJ) | |
16424 | ISWMDL(17) = ITEMP | |
16425 | IF(IREJ.NE.0) THEN | |
16426 | IF(IDEB(4).GE.2) THEN | |
16427 | WRITE(LO,'(/1X,A,I5)') | |
16428 | & 'PHO_STRING: sec.rejection by PHO_CDIFF',IREJ | |
16429 | CALL PHO_PREVNT(-1) | |
16430 | ENDIF | |
16431 | RETURN | |
16432 | ENDIF | |
16433 | KSDPO = KSDPO+1 | |
16434 | KSPOM = KSPOMS+KSPOM | |
16435 | KSREG = KSREGS+KSREG | |
16436 | KHPOM = KHPOMS+KHPOM | |
16437 | KHDIR = KHDIRS+KHDIR | |
16438 | ELSE | |
16439 | IDIF1 = 1 | |
16440 | IDIF2 = 1 | |
16441 | IF(IPORES(I).EQ.5) THEN | |
16442 | IDIF2 = 0 | |
16443 | KSTRG = KSTRG+1 | |
16444 | ELSE IF(IPORES(I).EQ.6) THEN | |
16445 | IDIF1 = 0 | |
16446 | KSTRG = KSTRG+1 | |
16447 | ELSE | |
16448 | KSLOO = KSLOO+1 | |
16449 | ENDIF | |
16450 | ITEMP = ISWMDL(16) | |
16451 | ISWMDL(16) = 0 | |
16452 | SPROB = 1.D0 | |
16453 | CALL PHO_DIFDIS(IDIF1,IDIF2,IPOPOS(1,I),IPOPOS(2,I),SPROB, | |
16454 | & 0,MSOFT,MHARD,IREJ) | |
16455 | ISWMDL(16) = ITEMP | |
16456 | IF(IREJ.NE.0) THEN | |
16457 | IF(IDEB(4).GE.2) THEN | |
16458 | WRITE(LO,'(/1X,A,I5)') | |
16459 | & 'PHO_STRING: sec.rejection by PHO_DIFDIS',IREJ | |
16460 | CALL PHO_PREVNT(-1) | |
16461 | ENDIF | |
16462 | RETURN | |
16463 | ENDIF | |
16464 | KSPOM = KSPOMS+KSPOM | |
16465 | KSREG = KSREGS+KSREG | |
16466 | KHPOM = KHPOMS+KHPOM | |
16467 | KHDIR = KHDIRS+KHDIR | |
16468 | ENDIF | |
16469 | IDIFR1 = IDDFS1 | |
16470 | IDIFR2 = IDDFS2 | |
16471 | IDDPOM = IDDPOS | |
16472 | 110 CONTINUE | |
16473 | IF(IPOIX2.GT.I2) THEN | |
16474 | IPOIX1 = I2+1 | |
16475 | GOTO 200 | |
16476 | ENDIF | |
16477 | ENDIF | |
16478 | ||
16479 | C optional: split gluons to q-qbar pairs | |
16480 | IF(ISWMDL(9).GT.0) THEN | |
16481 | NHEPO = NHEP | |
16482 | DO 30 I=3,NHEPO | |
16483 | IF((ISTHEP(I).EQ.-1).AND.(IDHEP(I).EQ.21)) THEN | |
16484 | ICG1=ICOLOR(1,I) | |
16485 | ICG2=ICOLOR(2,I) | |
16486 | IQ1 = 0 | |
16487 | IQ2 = 0 | |
16488 | DO 40 K=3,NHEPO | |
16489 | IF(ICOLOR(1,K).EQ.-ICG1) THEN | |
16490 | IQ1 = K | |
16491 | IF(IQ1*IQ2.NE.0) GOTO 45 | |
16492 | ELSE IF(ICOLOR(1,K).EQ.-ICG2) THEN | |
16493 | IQ2 = K | |
16494 | IF(IQ1*IQ2.NE.0) GOTO 45 | |
16495 | ENDIF | |
16496 | 40 CONTINUE | |
16497 | WRITE(LO,'(/1X,2A,3I6)') 'PHO_STRING:ERROR:(1) ', | |
16498 | & 'no matching color found (IG,ICG1,ICG2)',I,ICG1,ICG2 | |
16499 | CALL PHO_ABORT | |
16500 | 45 CONTINUE | |
16501 | CALL PHO_GLU2QU(I,IQ1,IQ2,IREJ) | |
16502 | IF(IREJ.NE.0) THEN | |
16503 | IF(IDEB(19).GE.5) THEN | |
16504 | WRITE(LO,'(/,1X,A)') | |
16505 | & 'PHO_STRING: no gluon splitting possible' | |
16506 | CALL PHO_PREVNT(0) | |
16507 | ENDIF | |
16508 | RETURN | |
16509 | ENDIF | |
16510 | ENDIF | |
16511 | 30 CONTINUE | |
16512 | ENDIF | |
16513 | ||
16514 | C construct strings and write entries sorted by strings | |
16515 | ||
16516 | ISTR = ISTR+1 | |
16517 | NHEPO = NHEP | |
16518 | DO 50 I=3,NHEPO | |
16519 | IF(ISTR.GT.MSTR) THEN | |
16520 | WRITE(LO,'(1X,2A,2I4)') 'PHO_STRING: ', | |
16521 | & 'event has too many strings (ISTR,MSTR):',ISTR,MSTR | |
16522 | CALL PHO_PREVNT(0) | |
16523 | IREJ = 1 | |
16524 | RETURN | |
16525 | ENDIF | |
16526 | IF(ISTHEP(I).EQ.1) THEN | |
16527 | C hadrons / resonances / clusters | |
16528 | NPOS(1,ISTR) = I | |
16529 | NPOS(2,ISTR) = 0 | |
16530 | NPOS(3,ISTR) = 0 | |
16531 | NPOS(4,ISTR) = abs(IPHIST(2,I)) | |
16532 | NCODE(ISTR) = -99 | |
16533 | IPHIST(1,I) = ISTR | |
16534 | ISTR = ISTR+1 | |
16535 | ELSE IF((ISTHEP(I).EQ.-1).AND.(IDHEP(I).NE.21)) THEN | |
16536 | C quark /diquark terminated strings | |
16537 | ICOL1 = -ICOLOR(1,I) | |
16538 | P1 = PHEP(1,I) | |
16539 | P2 = PHEP(2,I) | |
16540 | P3 = PHEP(3,I) | |
16541 | P4 = PHEP(4,I) | |
16542 | ICH1 = IPHO_CHR3(I,2) | |
16543 | IBA1 = IPHO_BAR3(I,2) | |
16544 | CALL PHO_REGPAR(-1,IDHEP(I),IMPART(I),I,0, | |
16545 | & P1,P2,P3,P4,IPHIST(1,I),IPHIST(2,I), | |
16546 | & ICOLOR(1,I),ICOLOR(2,I),IPOS,1) | |
16547 | JM1 = IPOS | |
16548 | ||
16549 | NRPOM = 0 | |
16550 | 65 CONTINUE | |
16551 | DO 55 K=3,NHEPO | |
16552 | IF(ISTHEP(K).EQ.-1)THEN | |
16553 | IF(IDHEP(K).EQ.21) THEN | |
16554 | IF(ICOLOR(1,K).EQ.ICOL1) THEN | |
16555 | ICOL1 = -ICOLOR(2,K) | |
16556 | GOTO 60 | |
16557 | ELSE IF(ICOLOR(2,K).EQ.ICOL1) THEN | |
16558 | ICOL1 = -ICOLOR(1,K) | |
16559 | GOTO 60 | |
16560 | ENDIF | |
16561 | ELSE IF(ICOLOR(1,K).EQ.ICOL1) THEN | |
16562 | ICOL1 = 0 | |
16563 | GOTO 60 | |
16564 | ENDIF | |
16565 | ENDIF | |
16566 | 55 CONTINUE | |
16567 | WRITE(LO,'(/1X,A,I5)') | |
16568 | & 'PHO_STRING:ERROR:(2) no matching color found for',-ICOL1 | |
16569 | CALL PHO_ABORT | |
16570 | 60 CONTINUE | |
16571 | P1 = P1+PHEP(1,K) | |
16572 | P2 = P2+PHEP(2,K) | |
16573 | P3 = P3+PHEP(3,K) | |
16574 | P4 = P4+PHEP(4,K) | |
16575 | NRPOM = MAX(NRPOM,IPHIST(1,K)) | |
16576 | ICH1 = ICH1+IPHO_CHR3(K,2) | |
16577 | IBA1 = IBA1+IPHO_BAR3(K,2) | |
16578 | CALL PHO_REGPAR(-1,IDHEP(K),IMPART(K),K,0, | |
16579 | & PHEP(1,K),PHEP(2,K),PHEP(3,K),PHEP(4,K), | |
16580 | & IPHIST(1,K),IPHIST(2,K),ICOLOR(1,K),ICOLOR(2,K),IPOS,1) | |
16581 | C further parton involved? | |
16582 | IF(ICOL1.NE.0) GOTO 65 | |
16583 | JM2 = IPOS | |
16584 | C register string | |
16585 | IGEN = IPHIST(2,K) | |
16586 | CALL PHO_REGPAR(-1,90,0,JM1,-JM2,P1,P2,P3,P4, | |
16587 | & ISTR,IGEN,ICH1,IBA1,IPOS,1) | |
16588 | C store additional string information | |
16589 | NPOS(1,ISTR) = IPOS | |
16590 | NPOS(2,ISTR) = JM1 | |
16591 | NPOS(3,ISTR) = -JM2 | |
16592 | NPOS(4,ISTR) = abs(IPHIST(2,K)) | |
16593 | C calculate CPC string codes | |
16594 | CALL PHO_ID2STR(IDHEP(JM1),IDHEP(JM2),NCODE(ISTR), | |
16595 | & IPAR1(ISTR),IPAR2(ISTR),IPAR3(ISTR),IPAR4(ISTR)) | |
16596 | ISTR = ISTR+1 | |
16597 | ENDIF | |
16598 | 50 CONTINUE | |
16599 | ||
16600 | DO 150 I=3,NHEPO | |
16601 | IF(ISTR.GT.MSTR) THEN | |
16602 | WRITE(LO,'(1X,2A,2I4)') 'PHO_STRING: ', | |
16603 | & 'event has too many strings (ISTR,MSTR):',ISTR,MSTR | |
16604 | CALL PHO_PREVNT(0) | |
16605 | IREJ = 1 | |
16606 | RETURN | |
16607 | ENDIF | |
16608 | IF(ISTHEP(I).EQ.-1) THEN | |
16609 | C gluon loop-strings | |
16610 | ICOL1 = -ICOLOR(1,I) | |
16611 | P1 = PHEP(1,I) | |
16612 | P2 = PHEP(2,I) | |
16613 | P3 = PHEP(3,I) | |
16614 | P4 = PHEP(4,I) | |
16615 | IBA1 = 0 | |
16616 | ICH1 = 0 | |
16617 | CALL PHO_REGPAR(-1,IDHEP(I),IMPART(I),I,0, | |
16618 | & P1,P2,P3,P4,IPHIST(1,I),IPHIST(2,I), | |
16619 | & ICOLOR(1,I),ICOLOR(2,I),IPOS,1) | |
16620 | JM1 = IPOS | |
16621 | C | |
16622 | NRPOM = 0 | |
16623 | 165 CONTINUE | |
16624 | IF(ICOLOR(2,I).EQ.ICOL1) GOTO 170 | |
16625 | DO 155 K=I,NHEPO | |
16626 | IF(ISTHEP(K).EQ.-1)THEN | |
16627 | IF(ICOLOR(1,K).EQ.ICOL1) THEN | |
16628 | ICOL1 = -ICOLOR(2,K) | |
16629 | GOTO 160 | |
16630 | ELSE IF(ICOLOR(2,K).EQ.ICOL1) THEN | |
16631 | ICOL1 = -ICOLOR(1,K) | |
16632 | GOTO 160 | |
16633 | ENDIF | |
16634 | ENDIF | |
16635 | 155 CONTINUE | |
16636 | WRITE(LO,'(/1X,A,I5)') | |
16637 | & 'PHO_STRING:ERROR:(3) no matching color found for',-ICOL1 | |
16638 | CALL PHO_ABORT | |
16639 | 160 CONTINUE | |
16640 | P1 = P1+PHEP(1,K) | |
16641 | P2 = P2+PHEP(2,K) | |
16642 | P3 = P3+PHEP(3,K) | |
16643 | P4 = P4+PHEP(4,K) | |
16644 | NRPOM = MAX(NRPOM,IPHIST(1,K)) | |
16645 | CALL PHO_REGPAR(-1,IDHEP(K),IMPART(K),K,0, | |
16646 | & PHEP(1,K),PHEP(2,K),PHEP(3,K),PHEP(4,K), | |
16647 | & IPHIST(1,K),IPHIST(2,K),ICOLOR(1,K),ICOLOR(2,K),IPOS,1) | |
16648 | C further parton involved? | |
16649 | IF(ICOL1.NE.0) GOTO 165 | |
16650 | 170 CONTINUE | |
16651 | JM2 = IPOS | |
16652 | C register string | |
16653 | IGEN = IPHIST(2,K) | |
16654 | CALL PHO_REGPAR(-1,90,0,JM1,-JM2,P1,P2,P3,P4, | |
16655 | & ISTR,IGEN,ICH1,IBA1,IPOS,1) | |
16656 | C store additional string information | |
16657 | NPOS(1,ISTR) = IPOS | |
16658 | NPOS(2,ISTR) = JM1 | |
16659 | NPOS(3,ISTR) = -JM2 | |
16660 | NPOS(4,ISTR) = abs(IPHIST(2,K)) | |
16661 | C calculate CPC string codes | |
16662 | CALL PHO_ID2STR(IDHEP(JM1),IDHEP(JM2),NCODE(ISTR), | |
16663 | & IPAR1(ISTR),IPAR2(ISTR),IPAR3(ISTR),IPAR4(ISTR)) | |
16664 | ISTR = ISTR+1 | |
16665 | ENDIF | |
16666 | 150 CONTINUE | |
16667 | ||
16668 | ISTR = ISTR-1 | |
16669 | ||
16670 | IF(IDEB(19).GE.17) THEN | |
16671 | WRITE(LO,'(1X,A)') 'PHO_STRING: after string construction' | |
16672 | CALL PHO_PREVNT(0) | |
16673 | ENDIF | |
16674 | ||
16675 | C pomeron corrections | |
16676 | CALL PHO_POMCOR(IREJ) | |
16677 | IF(IREJ.NE.0) THEN | |
16678 | IFAIL(38) = IFAIL(38)+1 | |
16679 | IF(IDEB(19).GE.3) THEN | |
16680 | WRITE(LO,'(1X,A,I6)') | |
16681 | & 'PHO_STRING: rejection by PHO_POMCOR (IREJ)',IREJ | |
16682 | CALL PHO_PREVNT(-1) | |
16683 | ENDIF | |
16684 | RETURN | |
16685 | ENDIF | |
16686 | ||
16687 | C string mass corrections | |
16688 | CALL PHO_MASCOR(IREJ) | |
16689 | IF(IREJ.NE.0) THEN | |
16690 | IFAIL(34) = IFAIL(34)+1 | |
16691 | IF(IDEB(19).GE.3) THEN | |
16692 | WRITE(LO,'(1X,A,I6)') | |
16693 | & 'PHO_STRING: rejection by PHO_MASCOR (IREJ)',IREJ | |
16694 | CALL PHO_PREVNT(-1) | |
16695 | ENDIF | |
16696 | RETURN | |
16697 | ENDIF | |
16698 | ||
16699 | C parton mass corrections | |
16700 | DO 100 I=1,ISTR | |
16701 | IF(NCODE(I).GE.0) THEN | |
16702 | CALL PHO_PARCOR(NPOS(1,I),IREJ) | |
16703 | IF(IREJ.NE.0) THEN | |
16704 | IFAIL(35) = IFAIL(35)+1 | |
16705 | IF(IDEB(19).GE.3) THEN | |
16706 | WRITE(LO,'(1X,A,I6)') | |
16707 | & 'PHO_STRING: rejection by PHO_PARCOR (IREJ)',IREJ | |
16708 | CALL PHO_PREVNT(-1) | |
16709 | ENDIF | |
16710 | RETURN | |
16711 | ENDIF | |
16712 | ENDIF | |
16713 | 100 CONTINUE | |
16714 | ||
16715 | C statistics of hard processes | |
16716 | DO 550 I=3,NHEP | |
16717 | IF(ISTHEP(I).EQ.25) THEN | |
16718 | K = IMPART(I) | |
16719 | II = IDHEP(I) | |
16720 | MH_acc_2(K,II) = MH_acc_2(K,II)+1 | |
16721 | ENDIF | |
16722 | 550 CONTINUE | |
16723 | ||
16724 | C debug: write out strings | |
16725 | IF(IDEB(19).GE.5) THEN | |
16726 | IF(IDEB(19).GE.10) | |
16727 | & CALL PHO_CHECK(1,IDEV) | |
16728 | IF(IDEB(19).GE.15) THEN | |
16729 | CALL PHO_PREVNT(0) | |
16730 | ELSE | |
16731 | CALL PHO_PRSTRG | |
16732 | ENDIF | |
16733 | ENDIF | |
16734 | ||
16735 | END | |
16736 | ||
16737 | *$ CREATE PHO_STRFRA.FOR | |
16738 | *COPY PHO_STRFRA | |
16739 | CDECK ID>, PHO_STRFRA | |
16740 | SUBROUTINE PHO_STRFRA(IREJ) | |
16741 | C******************************************************************** | |
16742 | C | |
16743 | C do all fragmentation of strings | |
16744 | C | |
16745 | C output: IREJ 0 successful | |
16746 | C 1 rejection | |
16747 | C 50 rejection due to user cutoffs | |
16748 | C | |
16749 | C******************************************************************** | |
16750 | IMPLICIT NONE | |
16751 | SAVE | |
16752 | ||
16753 | C input/output channels | |
16754 | INTEGER LI,LO | |
16755 | COMMON /POINOU/ LI,LO | |
16756 | C some constants | |
16757 | DOUBLE PRECISION PI,PI2,PI4,GEV2MB,Q_ch,Q_ch2,Q_ch4 | |
16758 | COMMON /POCONS/ PI,PI2,PI4,GEV2MB, | |
16759 | & Q_ch(-6:6),Q_ch2(-6:6),Q_ch4(-6:6) | |
16760 | C event debugging information | |
16761 | INTEGER NMAXD | |
16762 | PARAMETER (NMAXD=100) | |
16763 | INTEGER IDEB,KSPOM,KHPOM,KSREG,KHDIR,KACCEP,KSTRG,KHTRG,KSLOO, | |
16764 | & KHLOO,KSDPO,KHDPO,KEVENT,KSOFT,KHARD | |
16765 | COMMON /PODEBG/ IDEB(NMAXD),KSPOM,KHPOM,KSREG,KHDIR,KACCEP,KSTRG, | |
16766 | & KHTRG,KSLOO,KHLOO,KSDPO,KHDPO,KEVENT,KSOFT,KHARD | |
16767 | C general process information | |
16768 | INTEGER IPROCE,IDNODF,IDIFR1,IDIFR2,IDDPOM,IPRON | |
16769 | COMMON /POPRCS/ IPROCE,IDNODF,IDIFR1,IDIFR2,IDDPOM,IPRON(15,4) | |
16770 | C model switches and parameters | |
16771 | CHARACTER*8 MDLNA | |
16772 | INTEGER ISWMDL,IPAMDL | |
16773 | DOUBLE PRECISION PARMDL | |
16774 | COMMON /POMDLS/ MDLNA(50),ISWMDL(50),PARMDL(400),IPAMDL(400) | |
16775 | C global event kinematics and particle IDs | |
16776 | INTEGER IFPAP,IFPAB | |
16777 | DOUBLE PRECISION ECM,PCM,PMASS,PVIRT | |
16778 | COMMON /POGCMS/ ECM,PCM,PMASS(2),PVIRT(2),IFPAP(2),IFPAB(2) | |
16779 | C standard particle data interface | |
16780 | INTEGER NMXHEP | |
16781 | PARAMETER (NMXHEP=4000) | |
16782 | INTEGER NEVHEP,NHEP,ISTHEP,IDHEP,JMOHEP,JDAHEP | |
16783 | DOUBLE PRECISION PHEP,VHEP | |
16784 | COMMON /POEVT1/ NEVHEP,NHEP,ISTHEP(NMXHEP),IDHEP(NMXHEP), | |
16785 | & JMOHEP(2,NMXHEP),JDAHEP(2,NMXHEP),PHEP(5,NMXHEP), | |
16786 | & VHEP(4,NMXHEP) | |
16787 | C extension to standard particle data interface (PHOJET specific) | |
16788 | INTEGER IMPART,IPHIST,ICOLOR | |
16789 | COMMON /POEVT2/ IMPART(NMXHEP),IPHIST(2,NMXHEP),ICOLOR(2,NMXHEP) | |
16790 | C color string configurations including collapsed strings and hadrons | |
16791 | INTEGER MSTR | |
16792 | PARAMETER (MSTR=500) | |
16793 | INTEGER NPOS,NCODE,IPAR1,IPAR2,IPAR3,IPAR4,NNCH,IBHAD | |
16794 | COMMON /POSTRG/ NPOS(4,MSTR),NCODE(MSTR), | |
16795 | & IPAR1(MSTR),IPAR2(MSTR),IPAR3(MSTR),IPAR4(MSTR), | |
16796 | & NNCH(MSTR),IBHAD(MSTR),ISTR | |
16797 | ||
16798 | INTEGER IREJ | |
16799 | ||
16800 | DOUBLE PRECISION PX,PY,PZ,HE,XMB,PT1,PT2,DUM | |
16801 | INTEGER I,II,IJ,IFOUND,IP,IP_old,IPMOTH,IPOS,IBAM,IJOIN, | |
16802 | & IGEN,IS,ISH,ISTR,J,K1,K2,NHEP1,NLINES | |
16803 | ||
16804 | integer indx(500),indx_max | |
16805 | ||
16806 | DOUBLE PRECISION DT_RNDM | |
16807 | INTEGER ipho_pdg2id | |
16808 | EXTERNAL DT_RNDM,ipho_pdg2id | |
16809 | ||
16810 | DOUBLE PRECISION PYP,RQLUN | |
16811 | INTEGER PYK | |
16812 | ||
16813 | INTEGER MSTU,MSTJ | |
16814 | DOUBLE PRECISION PARU,PARJ | |
16815 | COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) | |
16816 | INTEGER N,NPAD,K | |
16817 | DOUBLE PRECISION P,V | |
16818 | COMMON/PYJETS/N,NPAD,K(4000,5),P(4000,5),V(4000,5) | |
16819 | ||
16820 | DIMENSION IJOIN(100) | |
16821 | ||
16822 | IREJ = 0 | |
16823 | IF(ABS(ISWMDL(6)).GT.3) THEN | |
16824 | WRITE(LO,'(/1X,2A,I3)') 'PHO_STRFRA:ERROR: ', | |
16825 | & 'invalid value of ISWMDL(6)',ISWMDL(6) | |
16826 | CALL PHO_ABORT | |
16827 | ENDIF | |
16828 | ||
16829 | C popcorn suppression | |
16830 | IF(PARMDL(134).GT.0.D0) THEN | |
16831 | IF(DT_RNDM(DUM).LT.PARMDL(134)) THEN | |
16832 | MSTJ(12) = 2 | |
16833 | ELSE | |
16834 | MSTJ(12) = 1 | |
16835 | ENDIF | |
16836 | ENDIF | |
16837 | ||
16838 | C copy partons to fragmentation code JETSET | |
16839 | IP = 0 | |
16840 | IP_old = 1 | |
16841 | ||
16842 | DO 300 J=1,ISTR | |
16843 | ||
16844 | C select partons with common production process | |
16845 | IGEN = NPOS(4,J) | |
16846 | if(IGEN.lt.0) goto 299 | |
16847 | ||
16848 | indx_max = 0 | |
16849 | DO 400 I=J,ISTR | |
16850 | if((IGEN.eq.NPOS(4,I)).or.(IPAMDL(17).eq.0)) then | |
16851 | ||
16852 | C write final particles/resonances to JETSET | |
16853 | IF(NCODE(I).EQ.-99) THEN | |
16854 | II = NPOS(1,I) | |
16855 | IP = IP+1 | |
16856 | P(IP,1) = PHEP(1,II) | |
16857 | P(IP,2) = PHEP(2,II) | |
16858 | P(IP,3) = PHEP(3,II) | |
16859 | P(IP,4) = PHEP(4,II) | |
16860 | P(IP,5) = PHEP(5,II) | |
16861 | K(IP,1) = 1 | |
16862 | K(IP,2) = IDHEP(II) | |
16863 | K(IP,3) = 0 | |
16864 | K(IP,4) = 0 | |
16865 | K(IP,5) = 0 | |
16866 | IPHIST(2,II) = IP | |
16867 | if(indx_max.eq.500) then | |
16868 | WRITE(LO,'(1x,2a,i8,I12)') 'PHO_STRFRA: ', | |
16869 | & 'no space left in index vector (indx,Kevent)', | |
16870 | & indx_max,KEVENT | |
16871 | IREJ = 1 | |
16872 | return | |
16873 | endif | |
16874 | indx_max = indx_max+1 | |
16875 | indx(indx_max) = II | |
16876 | C write partons to JETSET | |
16877 | ELSE IF(NCODE(I).GE.0) THEN | |
16878 | K1 = JMOHEP(1,NPOS(1,I)) | |
16879 | K2 = MAX(JMOHEP(1,NPOS(1,I)),-JMOHEP(2,NPOS(1,I))) | |
16880 | IJ = 0 | |
16881 | DO II=K1,K2 | |
16882 | IP = IP+1 | |
16883 | P(IP,1) = PHEP(1,II) | |
16884 | P(IP,2) = PHEP(2,II) | |
16885 | P(IP,3) = PHEP(3,II) | |
16886 | P(IP,4) = PHEP(4,II) | |
16887 | P(IP,5) = PHEP(5,II) | |
16888 | K(IP,1) = 1 | |
16889 | K(IP,2) = IDHEP(II) | |
16890 | K(IP,3) = 0 | |
16891 | K(IP,4) = 0 | |
16892 | K(IP,5) = 0 | |
16893 | IPHIST(2,II) = IP | |
16894 | IJ = IJ+1 | |
16895 | IJOIN(IJ) = IP | |
16896 | indx_max = indx_max+1 | |
16897 | indx(indx_max) = II | |
16898 | ENDDO | |
16899 | II = JMOHEP(2,NPOS(1,I)) | |
16900 | IF((II.GT.0).AND.(II.NE.K1)) THEN | |
16901 | IP = IP+1 | |
16902 | P(IP,1) = PHEP(1,II) | |
16903 | P(IP,2) = PHEP(2,II) | |
16904 | P(IP,3) = PHEP(3,II) | |
16905 | P(IP,4) = PHEP(4,II) | |
16906 | P(IP,5) = PHEP(5,II) | |
16907 | K(IP,1) = 1 | |
16908 | K(IP,2) = IDHEP(II) | |
16909 | K(IP,3) = 0 | |
16910 | K(IP,4) = 0 | |
16911 | K(IP,5) = 0 | |
16912 | IPHIST(2,II) = IP | |
16913 | IJ = IJ+1 | |
16914 | IJOIN(IJ) = IP | |
16915 | indx_max = indx_max+1 | |
16916 | indx(indx_max) = II | |
16917 | ENDIF | |
16918 | N = IP | |
16919 | C connect partons to strings | |
16920 | CALL PYJOIN(IJ,IJOIN) | |
16921 | ENDIF | |
16922 | ||
16923 | NPOS(4,I) = -NPOS(4,I) | |
16924 | endif | |
16925 | 400 continue | |
16926 | ||
16927 | C set Lund counter | |
16928 | N = IP | |
16929 | if(IP.eq.0) goto 299 | |
16930 | ||
16931 | C hard final state evolution | |
16932 | IF((ISWMDL(8).EQ.1).OR.(ISWMDL(8).EQ.3)) THEN | |
16933 | ISH = 0 | |
16934 | do 125 k1=1,indx_max | |
16935 | I = indx(k1) | |
16936 | IF(IPHIST(1,I).LE.-100) THEN | |
16937 | ISH = ISH+1 | |
16938 | IJOIN(ISH) = I | |
16939 | ENDIF | |
16940 | 125 continue | |
16941 | IF(ISH.GE.2) THEN | |
16942 | DO 130 K1=1,ISH | |
16943 | IF(IJOIN(K1).EQ.0) GOTO 130 | |
16944 | I = IJOIN(K1) | |
16945 | IF((IPAMDL(102).EQ.1) | |
16946 | & .AND.(IPHIST(1,I).NE.-100)) GOTO 130 | |
16947 | DO 135 K2=K1+1,ISH | |
16948 | IF(IJOIN(K2).EQ.0) GOTO 135 | |
16949 | II = IJOIN(K2) | |
16950 | IF(IPHIST(1,I).EQ.IPHIST(1,II)) THEN | |
16951 | PT1 = SQRT(PHEP(1,II)**2+PHEP(2,II)**2) | |
16952 | PT2 = SQRT(PHEP(1,I)**2+PHEP(2,I)**2) | |
16953 | RQLUN = MIN(PT1,PT2) | |
16954 | IF(IDEB(22).GE.10) WRITE(LO,'(1X,A,2I5,E12.4)') | |
16955 | & 'PHO_STRFRA: PYSHOW called',I,II,RQLUN | |
16956 | CALL PYSHOW(IPHIST(2,I),IPHIST(2,II),RQLUN) | |
16957 | IJOIN(K1) = 0 | |
16958 | IJOIN(K2) = 0 | |
16959 | GOTO 130 | |
16960 | ENDIF | |
16961 | 135 CONTINUE | |
16962 | 130 CONTINUE | |
16963 | ENDIF | |
16964 | ENDIF | |
16965 | ||
16966 | C fragment parton / hadron configuration (hadronization & decay) | |
16967 | ||
16968 | IF(ISWMDL(6).NE.0) THEN | |
16969 | II = MSTU(21) | |
16970 | MSTU(21) = 1 | |
16971 | CALL PYEXEC | |
16972 | MSTU(21) = II | |
16973 | C Lund warning? | |
16974 | if(MSTU(28).ne.0) then | |
16975 | IF(IDEB(22).GE.10) THEN | |
16976 | WRITE(LO,'(1X,A,I12,I3)') | |
16977 | & 'PHO_STRFRA:(1) Lund code warning (EV/code)', | |
16978 | & KEVENT,MSTU(28) | |
16979 | CALL PHO_PREVNT(2) | |
16980 | ENDIF | |
16981 | endif | |
16982 | C event accepted? | |
16983 | IF(MSTU(24).NE.0) THEN | |
16984 | IF(IDEB(22).GE.2) THEN | |
16985 | WRITE(LO,'(1X,A,I12,I3)') | |
16986 | & 'PHO_STRFRA:(1) rejection by Lund code (EV/code)', | |
16987 | & KEVENT,MSTU(24) | |
16988 | CALL PHO_PREVNT(2) | |
16989 | ENDIF | |
16990 | IREJ = 1 | |
16991 | RETURN | |
16992 | ENDIF | |
16993 | ENDIF | |
16994 | ||
16995 | IP = N | |
16996 | C change particle status in JETSET to avoid internal adjustments | |
16997 | do k1=IP_old,IP | |
16998 | K(k1,1) = K(k1,1)+1000 | |
16999 | enddo | |
17000 | IP_old = IP+1 | |
17001 | ||
17002 | 299 continue | |
17003 | 300 CONTINUE | |
17004 | ||
17005 | C restore original JETSET particle status codes | |
17006 | do i=1,N | |
17007 | K(i,1) = K(i,1)-1000 | |
17008 | enddo | |
17009 | ||
17010 | * IF(IDEB(22).GE.25) THEN | |
17011 | * WRITE(LO,'(//1X,2A)') 'PHO_STRFRA: ', | |
17012 | * & 'particle/string system before fragmentation' | |
17013 | * CALL PHO_PREVNT(2) | |
17014 | * ENDIF | |
17015 | ||
17016 | C copy hadrons back to POEVT1 / POEVT2 | |
17017 | ||
17018 | IF(IP.GT.0) THEN | |
17019 | NHEP1 = NHEP+1 | |
17020 | NLINES = PYK(0,1) | |
17021 | C copy hadrons back with full history information | |
17022 | IF(IPAMDL(178).EQ.1) THEN | |
17023 | DO 155 II=1,ISTR | |
17024 | IF(NCODE(II).GE.0) THEN | |
17025 | K1 = IPHIST(2,NPOS(2,II)) | |
17026 | K2 = IPHIST(2,-NPOS(3,II)) | |
17027 | ELSE IF(NCODE(II).EQ.-99) THEN | |
17028 | K1 = IPHIST(2,NPOS(1,II)) | |
17029 | K2 = K1 | |
17030 | ELSE | |
17031 | GOTO 149 | |
17032 | ENDIF | |
17033 | IFOUND = 0 | |
17034 | DO 160 J=1,NLINES | |
17035 | IF(PYK(J,7).EQ.1) THEN | |
17036 | IPMOTH = PYK(J,15) | |
17037 | IF((IPMOTH.GE.K1).AND.(IPMOTH.LE.K2)) THEN | |
17038 | IBAM = ipho_pdg2id(PYK(J,8)) | |
17039 | IF((IBAM.EQ.0).AND.(ISWMDL(6).NE.0)) THEN | |
17040 | IF(IDEB(22).GE.2) THEN | |
17041 | WRITE(LO,'(/1X,2A)') 'PHO_STRFRA: ', | |
17042 | & 'LUND interface (1) rejection' | |
17043 | CALL PHO_PREVNT(2) | |
17044 | ENDIF | |
17045 | IREJ = 1 | |
17046 | RETURN | |
17047 | ENDIF | |
17048 | IFOUND = IFOUND+1 | |
17049 | PX = PYP(J,1) | |
17050 | PY = PYP(J,2) | |
17051 | PZ = PYP(J,3) | |
17052 | HE = PYP(J,4) | |
17053 | XMB = PYP(J,5)**2 | |
17054 | C register parton/hadron | |
17055 | IS = 1 | |
17056 | IF(IBAM.EQ.0) THEN | |
17057 | IF(ISWMDL(6).EQ.0) THEN | |
17058 | IS = -1 | |
17059 | ELSE | |
17060 | IF(IDEB(22).GE.2) THEN | |
17061 | WRITE(LO,'(/1X,2A)') 'PHO_STRFRA: ', | |
17062 | & 'LUND interface (2) rejection' | |
17063 | CALL PHO_PREVNT(2) | |
17064 | ENDIF | |
17065 | IREJ = 1 | |
17066 | RETURN | |
17067 | ENDIF | |
17068 | ENDIF | |
17069 | CALL PHO_REGPAR(IS,PYK(J,8),IBAM,NPOS(1,II),0, | |
17070 | & PX,PY,PZ,HE,J,0,0,0,IPOS,1) | |
17071 | ISTHEP(IPOS) = 1 | |
17072 | ENDIF | |
17073 | ENDIF | |
17074 | 160 CONTINUE | |
17075 | IF(IFOUND.EQ.0) THEN | |
17076 | IF(IDEB(2).GE.2) THEN | |
17077 | WRITE(LO,'(2A,I12,I3)') 'PHO_STRFRA: ', | |
17078 | & 'no particles found for string (EVE,ISTR):',KEVENT,II | |
17079 | ENDIF | |
17080 | ISTHEP(NPOS(1,II)) = 2 | |
17081 | ENDIF | |
17082 | 149 CONTINUE | |
17083 | 155 CONTINUE | |
17084 | ELSE | |
17085 | C copy hadrons back without history information | |
17086 | JDAHEP(1,1) = NHEP1 | |
17087 | JDAHEP(1,2) = NHEP1 | |
17088 | DO 170 J=1,NLINES | |
17089 | IF(PYK(J,7).EQ.1) THEN | |
17090 | IBAM = ipho_pdg2id(PYK(J,8)) | |
17091 | IF((IBAM.EQ.99999).AND.(ISWMDL(6).NE.0)) THEN | |
17092 | IF(IDEB(22).GE.2) THEN | |
17093 | WRITE(LO,'(/1X,A)') | |
17094 | & 'PHO_STRFRA: LUND interface (3) rejection' | |
17095 | CALL PHO_PREVNT(2) | |
17096 | ENDIF | |
17097 | IREJ = 1 | |
17098 | RETURN | |
17099 | ENDIF | |
17100 | PX = PYP(J,1) | |
17101 | PY = PYP(J,2) | |
17102 | PZ = PYP(J,3) | |
17103 | HE = PYP(J,4) | |
17104 | XMB = PYP(J,5)**2 | |
17105 | C register parton/hadron | |
17106 | IS = 1 | |
17107 | IF(IBAM.EQ.0) THEN | |
17108 | IF(ISWMDL(6).EQ.0) THEN | |
17109 | IS = -1 | |
17110 | ELSE | |
17111 | IF(IDEB(22).GE.2) THEN | |
17112 | WRITE(LO,'(/1X,A)') | |
17113 | & 'PHO_STRFRA: LUND interface (4) rejection' | |
17114 | CALL PHO_PREVNT(2) | |
17115 | ENDIF | |
17116 | IREJ = 1 | |
17117 | RETURN | |
17118 | ENDIF | |
17119 | ENDIF | |
17120 | CALL PHO_REGPAR(IS,PYK(J,8),IBAM,1,2,PX,PY,PZ, | |
17121 | & HE,J,0,0,0,IPOS,1) | |
17122 | ISTHEP(IPOS) = 1 | |
17123 | ENDIF | |
17124 | 170 CONTINUE | |
17125 | DO 180 II=1,ISTR | |
17126 | IF((NCODE(II).GE.0).OR.(NCODE(II).EQ.-99)) | |
17127 | & ISTHEP(NPOS(1,II)) = 2 | |
17128 | 180 CONTINUE | |
17129 | ENDIF | |
17130 | ENDIF | |
17131 | ||
17132 | C debug event status | |
17133 | IF(IDEB(22).GE.15) THEN | |
17134 | WRITE(LO,'(//1X,A)') | |
17135 | & 'PHO_STRFRA: particle system after fragmentation' | |
17136 | CALL PHO_PREVNT(2) | |
17137 | ENDIF | |
17138 | ||
17139 | END | |
17140 | ||
17141 | *$ CREATE PHO_EVEINI.FOR | |
17142 | *COPY PHO_EVEINI | |
17143 | CDECK ID>, PHO_EVEINI | |
17144 | SUBROUTINE PHO_EVEINI(IMODE,P1,P2,IP1,IP2) | |
17145 | C******************************************************************** | |
17146 | C | |
17147 | C prepare /POEVT1/ for new event | |
17148 | C | |
17149 | C first subroutine called for each event | |
17150 | C | |
17151 | C input: P1(4) particle 1 | |
17152 | C P2(4) particle 2 | |
17153 | C IMODE 0 general initialization | |
17154 | C 1 initialization of particles and kinematics | |
17155 | C 2 initialization after internal rejection | |
17156 | C | |
17157 | C output: IP1,IP2 index of interacting particles | |
17158 | C | |
17159 | C******************************************************************** | |
17160 | IMPLICIT DOUBLE PRECISION (A-H,O-Z) | |
17161 | SAVE | |
17162 | ||
17163 | DIMENSION P1(4),P2(4) | |
17164 | ||
17165 | PARAMETER ( EPS = 1.D-5, | |
17166 | & DEPS = 1.D-15 ) | |
17167 | ||
17168 | C input/output channels | |
17169 | INTEGER LI,LO | |
17170 | COMMON /POINOU/ LI,LO | |
17171 | C event debugging information | |
17172 | INTEGER NMAXD | |
17173 | PARAMETER (NMAXD=100) | |
17174 | INTEGER IDEB,KSPOM,KHPOM,KSREG,KHDIR,KACCEP,KSTRG,KHTRG,KSLOO, | |
17175 | & KHLOO,KSDPO,KHDPO,KEVENT,KSOFT,KHARD | |
17176 | COMMON /PODEBG/ IDEB(NMAXD),KSPOM,KHPOM,KSREG,KHDIR,KACCEP,KSTRG, | |
17177 | & KHTRG,KSLOO,KHLOO,KSDPO,KHDPO,KEVENT,KSOFT,KHARD | |
17178 | C model switches and parameters | |
17179 | CHARACTER*8 MDLNA | |
17180 | INTEGER ISWMDL,IPAMDL | |
17181 | DOUBLE PRECISION PARMDL | |
17182 | COMMON /POMDLS/ MDLNA(50),ISWMDL(50),PARMDL(400),IPAMDL(400) | |
17183 | C general process information | |
17184 | INTEGER IPROCE,IDNODF,IDIFR1,IDIFR2,IDDPOM,IPRON | |
17185 | COMMON /POPRCS/ IPROCE,IDNODF,IDIFR1,IDIFR2,IDDPOM,IPRON(15,4) | |
17186 | C gamma-lepton or gamma-hadron vertex information | |
17187 | INTEGER IGHEL,IDPSRC,IDBSRC | |
17188 | DOUBLE PRECISION PINI,PFIN,PGAM,GYY,GQ2,GGECM,GAIMP,PFTHE,PFPHI, | |
17189 | & RADSRC,AMSRC,GAMSRC | |
17190 | COMMON /POFSRC/ PINI(5,2),PFIN(5,2),PGAM(5,2),IGHEL(2), | |
17191 | & GYY(2),GQ2(2),GGECM,GAIMP(2),PFTHE(2),PFPHI(2), | |
17192 | & IDPSRC(2),IDBSRC(2),RADSRC(2),AMSRC(2),GAMSRC(2) | |
17193 | C global event kinematics and particle IDs | |
17194 | INTEGER IFPAP,IFPAB | |
17195 | DOUBLE PRECISION ECM,PCM,PMASS,PVIRT | |
17196 | COMMON /POGCMS/ ECM,PCM,PMASS(2),PVIRT(2),IFPAP(2),IFPAB(2) | |
17197 | C energy-interpolation table | |
17198 | INTEGER IEETA2 | |
17199 | PARAMETER ( IEETA2 = 20 ) | |
17200 | INTEGER ISIMAX | |
17201 | DOUBLE PRECISION SIGTAB,SIGECM | |
17202 | COMMON /POTABL/ SIGTAB(4,80,IEETA2),SIGECM(4,IEETA2),ISIMAX | |
17203 | C cross sections | |
17204 | INTEGER IPFIL,IFAFIL,IFBFIL | |
17205 | DOUBLE PRECISION SIGTOT,SIGELA,SIGVM,SIGINE,SIGNDF,SIGDIR, | |
17206 | & SIGLSD,SIGHSD,SIGLDD,SIGHDD,SIGCDF, | |
17207 | & SIGPOM,SIGREG,SIGHAR,SIGTR1,SIGTR2,SIGLOO, | |
17208 | & SIGDPO,SIG1SO,SIG1HA,SLOEL,SLOVM,SIGCOR, | |
17209 | & FSUP,FSUD,FSUH,ECMFIL,P2AFIL,P2BFIL | |
17210 | COMMON /POCSEC/ SIGTOT,SIGELA,SIGVM(0:4,0:4),SIGINE,SIGNDF,SIGDIR, | |
17211 | & SIGLSD(2),SIGHSD(2),SIGLDD,SIGHDD,SIGCDF(0:4), | |
17212 | & SIGPOM,SIGREG,SIGHAR,SIGTR1(2),SIGTR2(2),SIGLOO, | |
17213 | & SIGDPO(4),SIG1SO,SIG1HA,SLOEL,SLOVM(4,4),SIGCOR, | |
17214 | & FSUP(2),FSUD(2),FSUH(2),ECMFIL,P2AFIL,P2BFIL, | |
17215 | & IPFIL,IFAFIL,IFBFIL | |
17216 | C color string configurations including collapsed strings and hadrons | |
17217 | INTEGER MSTR | |
17218 | PARAMETER (MSTR=500) | |
17219 | INTEGER NPOS,NCODE,IPAR1,IPAR2,IPAR3,IPAR4,NNCH,IBHAD | |
17220 | COMMON /POSTRG/ NPOS(4,MSTR),NCODE(MSTR), | |
17221 | & IPAR1(MSTR),IPAR2(MSTR),IPAR3(MSTR),IPAR4(MSTR), | |
17222 | & NNCH(MSTR),IBHAD(MSTR),ISTR | |
17223 | C standard particle data interface | |
17224 | INTEGER NMXHEP | |
17225 | PARAMETER (NMXHEP=4000) | |
17226 | INTEGER NEVHEP,NHEP,ISTHEP,IDHEP,JMOHEP,JDAHEP | |
17227 | DOUBLE PRECISION PHEP,VHEP | |
17228 | COMMON /POEVT1/ NEVHEP,NHEP,ISTHEP(NMXHEP),IDHEP(NMXHEP), | |
17229 | & JMOHEP(2,NMXHEP),JDAHEP(2,NMXHEP),PHEP(5,NMXHEP), | |
17230 | & VHEP(4,NMXHEP) | |
17231 | C extension to standard particle data interface (PHOJET specific) | |
17232 | INTEGER IMPART,IPHIST,ICOLOR | |
17233 | COMMON /POEVT2/ IMPART(NMXHEP),IPHIST(2,NMXHEP),ICOLOR(2,NMXHEP) | |
17234 | C table of particle indices for recursive PHOJET calls | |
17235 | INTEGER MAXIPX | |
17236 | PARAMETER ( MAXIPX = 100 ) | |
17237 | INTEGER IPOPOS,IPORES,IPOIX1,IPOIX2,IPOIX3 | |
17238 | COMMON /PORECU/ IPOPOS(2,MAXIPX),IPORES(MAXIPX), | |
17239 | & IPOIX1,IPOIX2,IPOIX3 | |
17240 | C event weights and generated cross section | |
17241 | INTEGER IPOWGC,ISWCUT,IVWGHT | |
17242 | DOUBLE PRECISION SIGGEN,HSWGHT,HSWCUT,EVWGHT | |
17243 | COMMON /POWGHT/ SIGGEN(4),HSWGHT(0:10),HSWCUT(20),EVWGHT(0:10), | |
17244 | & IPOWGC(0:10),ISWCUT(20),IVWGHT(0:10) | |
17245 | ||
17246 | DIMENSION IM(2) | |
17247 | ||
17248 | C reset debug variables | |
17249 | KSPOM = 0 | |
17250 | KHPOM = 0 | |
17251 | KSREG = 0 | |
17252 | KHDIR = 0 | |
17253 | KSTRG = 0 | |
17254 | KHTRG = 0 | |
17255 | KSLOO = 0 | |
17256 | KHLOO = 0 | |
17257 | KSDPO = 0 | |
17258 | KSOFT = 0 | |
17259 | KHARD = 0 | |
17260 | C | |
17261 | IDNODF = 0 | |
17262 | IDIFR1 = 0 | |
17263 | IDIFR2 = 0 | |
17264 | IDDPOM = 0 | |
17265 | ISTR = 0 | |
17266 | IPOIX1 = 0 | |
17267 | IF(ISWMDL(14).GT.0) IPOIX1 = 1 | |
17268 | IPOIX2 = 0 | |
17269 | IPOIX3 = 0 | |
17270 | C reset /POEVT1/ and /POEVT2/ | |
17271 | CALL PHO_REGPAR(0,0,0,0,0,0.D0,0.D0,0.D0,0.D0, | |
17272 | & 0,0,0,0,IPOS,0) | |
17273 | CALL PHO_SELCOL(0,0,0,0,0,0,0) | |
17274 | DO 15 I=0,10 | |
17275 | IPOWGC(I) = 0 | |
17276 | 15 CONTINUE | |
17277 | ||
17278 | C initialization of particle kinematics | |
17279 | ||
17280 | C lepton-photon/hadron-photon vertex and initial particles | |
17281 | IM(1) = 0 | |
17282 | IM(2) = 0 | |
17283 | IF((IPAMDL(11).GT.0).AND.(IDPSRC(1).NE.0)) THEN | |
17284 | CALL PHO_REGPAR(1,IDPSRC(1),IDBSRC(1),0,0,PINI(1,1),PINI(2,1), | |
17285 | & PINI(3,1),PINI(4,1),0,0,0,0,IM(1),1) | |
17286 | ELSE | |
17287 | CALL PHO_REGPAR(1,IFPAP(1),IFPAB(1),IM(1),0,P1(1),P1(2),P1(3), | |
17288 | & P1(4),0,0,0,0,IP1,1) | |
17289 | ENDIF | |
17290 | IF((IPAMDL(12).GT.0).AND.(IDPSRC(2).NE.0)) THEN | |
17291 | CALL PHO_REGPAR(1,IDPSRC(2),IDBSRC(2),0,0,PINI(1,2),PINI(2,2), | |
17292 | & PINI(3,2),PINI(4,2),0,0,0,0,IM(2),1) | |
17293 | ELSE | |
17294 | CALL PHO_REGPAR(1,IFPAP(2),IFPAB(2),IM(2),0,P2(1),P2(2),P2(3), | |
17295 | & P2(4),0,0,0,0,IP2,1) | |
17296 | ENDIF | |
17297 | IF((IPAMDL(11).GT.0).AND.(IDPSRC(1).NE.0)) THEN | |
17298 | CALL PHO_REGPAR(1,IDPSRC(1),IDBSRC(1),IM(1),0,PFIN(1,1), | |
17299 | & PFIN(2,1),PFIN(3,1),PFIN(4,1),0,10,0,0,IPOS,1) | |
17300 | CALL PHO_REGPAR(1,IFPAP(1),IFPAB(1),IM(1),0,P1(1),P1(2),P1(3), | |
17301 | & P1(4),0,0,0,0,IP1,1) | |
17302 | ENDIF | |
17303 | IF((IPAMDL(12).GT.0).AND.(IDPSRC(2).NE.0)) THEN | |
17304 | CALL PHO_REGPAR(1,IDPSRC(2),IDBSRC(2),IM(2),0,PFIN(1,2), | |
17305 | & PFIN(2,2),PFIN(3,2),PFIN(4,2),0,10,0,0,IPOS,1) | |
17306 | CALL PHO_REGPAR(1,IFPAP(2),IFPAB(2),IM(2),0,P2(1),P2(2),P2(3), | |
17307 | & P2(4),0,0,0,0,IP2,1) | |
17308 | ENDIF | |
17309 | NEVHEP = KACCEP | |
17310 | ||
17311 | IF(IMODE.LE.1) THEN | |
17312 | C CMS energy | |
17313 | ECM = SQRT((P1(4)+P2(4))**2-(P1(1)+P2(1))**2-(P1(2)+P2(2))**2 | |
17314 | & -(P1(3)+P2(3))**2) | |
17315 | * CALL PHO_PECMS(1,PMASS(1),PMASS(2),ECM,PCM,EE) | |
17316 | PMASS(1) = PHEP(5,IP1) | |
17317 | PVIRT(1) = 0.D0 | |
17318 | IF(IFPAP(1).EQ.22) PVIRT(1) = PMASS(1)**2 | |
17319 | PMASS(2) = PHEP(5,IP2) | |
17320 | PVIRT(2) = 0.D0 | |
17321 | IF(IFPAP(2).EQ.22) PVIRT(2) = PMASS(2)**2 | |
17322 | ENDIF | |
17323 | ||
17324 | C cross section calculations | |
17325 | ||
17326 | IF(IMODE.NE.1) THEN | |
17327 | IP = 1 | |
17328 | CALL PHO_CSINT(IP,IFPAP(1),IFPAP(2),IGHEL(1),IGHEL(2), | |
17329 | & ECM,PVIRT(1),PVIRT(2)) | |
17330 | ENDIF | |
17331 | ||
17332 | IF(IMODE.LE.0) THEN | |
17333 | C effective cross section | |
17334 | SIGGEN(3) = 0.D0 | |
17335 | IF(ISWMDL(2).ge.1) THEN | |
17336 | IF(IPRON(1,1).EQ.1) SIGGEN(3) = SIGTOT-SIGELA-SIGVM(0,0) | |
17337 | & -SIGCDF(0)-SIGLSD(1)-SIGHSD(1)-SIGLSD(2)-SIGHSD(2)-SIGLDD | |
17338 | & -SIGHDD-SIGDIR | |
17339 | IF(IPRON(2,1).EQ.1) SIGGEN(3) = SIGGEN(3)+SIGELA | |
17340 | IF(IPRON(3,1).EQ.1) SIGGEN(3) = SIGGEN(3)+SIGVM(0,0) | |
17341 | IF(IPRON(4,1).EQ.1) SIGGEN(3) = SIGGEN(3)+SIGCDF(0) | |
17342 | IF(IPRON(5,1).EQ.1) SIGGEN(3) = SIGGEN(3)+SIGLSD(1)+SIGHSD(1) | |
17343 | IF(IPRON(6,1).EQ.1) SIGGEN(3) = SIGGEN(3)+SIGLSD(2)+SIGHSD(2) | |
17344 | IF(IPRON(7,1).EQ.1) SIGGEN(3) = SIGGEN(3)+SIGLDD+SIGHDD | |
17345 | IF(IPRON(8,1).EQ.1) SIGGEN(3) = SIGGEN(3)+SIGDIR | |
17346 | C simulate only hard scatterings | |
17347 | ELSE | |
17348 | IF(IPRON(1,1).EQ.1) SIGGEN(3) = SIGHAR | |
17349 | IF(IPRON(8,1).EQ.1) SIGGEN(3) = SIGGEN(3)+SIGDIR | |
17350 | ENDIF | |
17351 | ||
17352 | ENDIF | |
17353 | ||
17354 | C reset of mother/daughter relations only (IMODE = 2) | |
17355 | ||
17356 | C debug output | |
17357 | IF(IDEB(63).GE.15) THEN | |
17358 | WRITE(LO,'(/1X,2A,I12,I3)') 'PHO_EVEINI: ', | |
17359 | & '/POEVT1/ initialized (event/mode)',KEVENT,IMODE | |
17360 | IF(IMODE.LE.0) THEN | |
17361 | WRITE(LO,'(1X,2A,/,5X,1P,6E12.4)') 'PHO_EVEINI: ', | |
17362 | & 'current suppression factors total-1/2 hard-1/2 diff-1/2:', | |
17363 | & FSUP,FSUH,FSUD | |
17364 | ONEM = -1.D0 | |
17365 | ITMP = IDEB(57) | |
17366 | IDEB(57) = MAX(5,ITMP) | |
17367 | CALL PHO_XSECT(1,0,ONEM) | |
17368 | IDEB(57) = ITMP | |
17369 | ENDIF | |
17370 | CALL PHO_PREVNT(0) | |
17371 | ENDIF | |
17372 | ||
17373 | END | |
17374 | ||
17375 | *$ CREATE PHO_CSINT.FOR | |
17376 | *COPY PHO_CSINT | |
17377 | CDECK ID>, PHO_CSINT | |
17378 | SUBROUTINE PHO_CSINT(IP,IFPA,IFPB,IHLA,IHLB,ECM,PVIR2A,PVIR2B) | |
17379 | C******************************************************************** | |
17380 | C | |
17381 | C calculate cross sections by interpolation | |
17382 | C | |
17383 | C input: IP particle combination | |
17384 | C IFPA/B particle PDG number | |
17385 | C IHLA/B particle helicity (photons only) | |
17386 | C ECM c.m. energy (GeV) | |
17387 | C PVIR2A virtuality of particle A (GeV**2, positive) | |
17388 | C PVIR2B virtuality of particle B (GeV**2, positive) | |
17389 | C | |
17390 | C output: cross sections stored in /POCSEC/ | |
17391 | C | |
17392 | C******************************************************************** | |
17393 | IMPLICIT DOUBLE PRECISION (A-H,O-Z) | |
17394 | SAVE | |
17395 | ||
17396 | PARAMETER ( EPS = 1.D-5, | |
17397 | & DEPS = 1.D-15 ) | |
17398 | ||
17399 | C input/output channels | |
17400 | INTEGER LI,LO | |
17401 | COMMON /POINOU/ LI,LO | |
17402 | C some constants | |
17403 | DOUBLE PRECISION PI,PI2,PI4,GEV2MB,Q_ch,Q_ch2,Q_ch4 | |
17404 | COMMON /POCONS/ PI,PI2,PI4,GEV2MB, | |
17405 | & Q_ch(-6:6),Q_ch2(-6:6),Q_ch4(-6:6) | |
17406 | C event debugging information | |
17407 | INTEGER NMAXD | |
17408 | PARAMETER (NMAXD=100) | |
17409 | INTEGER IDEB,KSPOM,KHPOM,KSREG,KHDIR,KACCEP,KSTRG,KHTRG,KSLOO, | |
17410 | & KHLOO,KSDPO,KHDPO,KEVENT,KSOFT,KHARD | |
17411 | COMMON /PODEBG/ IDEB(NMAXD),KSPOM,KHPOM,KSREG,KHDIR,KACCEP,KSTRG, | |
17412 | & KHTRG,KSLOO,KHLOO,KSDPO,KHDPO,KEVENT,KSOFT,KHARD | |
17413 | C model switches and parameters | |
17414 | CHARACTER*8 MDLNA | |
17415 | INTEGER ISWMDL,IPAMDL | |
17416 | DOUBLE PRECISION PARMDL | |
17417 | COMMON /POMDLS/ MDLNA(50),ISWMDL(50),PARMDL(400),IPAMDL(400) | |
17418 | C energy-interpolation table | |
17419 | INTEGER IEETA2 | |
17420 | PARAMETER ( IEETA2 = 20 ) | |
17421 | INTEGER ISIMAX | |
17422 | DOUBLE PRECISION SIGTAB,SIGECM | |
17423 | COMMON /POTABL/ SIGTAB(4,80,IEETA2),SIGECM(4,IEETA2),ISIMAX | |
17424 | C cross sections | |
17425 | INTEGER IPFIL,IFAFIL,IFBFIL | |
17426 | DOUBLE PRECISION SIGTOT,SIGELA,SIGVM,SIGINE,SIGNDF,SIGDIR, | |
17427 | & SIGLSD,SIGHSD,SIGLDD,SIGHDD,SIGCDF, | |
17428 | & SIGPOM,SIGREG,SIGHAR,SIGTR1,SIGTR2,SIGLOO, | |
17429 | & SIGDPO,SIG1SO,SIG1HA,SLOEL,SLOVM,SIGCOR, | |
17430 | & FSUP,FSUD,FSUH,ECMFIL,P2AFIL,P2BFIL | |
17431 | COMMON /POCSEC/ SIGTOT,SIGELA,SIGVM(0:4,0:4),SIGINE,SIGNDF,SIGDIR, | |
17432 | & SIGLSD(2),SIGHSD(2),SIGLDD,SIGHDD,SIGCDF(0:4), | |
17433 | & SIGPOM,SIGREG,SIGHAR,SIGTR1(2),SIGTR2(2),SIGLOO, | |
17434 | & SIGDPO(4),SIG1SO,SIG1HA,SLOEL,SLOVM(4,4),SIGCOR, | |
17435 | & FSUP(2),FSUD(2),FSUH(2),ECMFIL,P2AFIL,P2BFIL, | |
17436 | & IPFIL,IFAFIL,IFBFIL | |
17437 | C hard cross sections and MC selection weights | |
17438 | INTEGER Max_pro_2 | |
17439 | PARAMETER ( Max_pro_2 = 16 ) | |
17440 | INTEGER IHa_last,IHb_last,MH_pro_on,MH_tried, | |
17441 | & MH_acc_1,MH_acc_2 | |
17442 | DOUBLE PRECISION Hfac,HWgx,HSig,Hdpt,HEcm_last,HQ2a_last,HQ2b_last | |
17443 | COMMON /POHRCS/ Hfac(-1:Max_pro_2),HWgx(-1:Max_pro_2), | |
17444 | & HSig(-1:Max_pro_2),Hdpt(-1:Max_pro_2), | |
17445 | & HEcm_last,HQ2a_last,HQ2b_last,IHa_last,IHb_last, | |
17446 | & MH_pro_on(-1:Max_pro_2,0:4),MH_tried(-1:Max_pro_2,0:4), | |
17447 | & MH_acc_1(-1:Max_pro_2,0:4),MH_acc_2(-1:Max_pro_2,0:4) | |
17448 | ||
17449 | DIMENSION PVIRT(2),SIGSRH(2),FSUT(2),FSUL(2),IFPAP(2),IHEL(2) | |
17450 | ||
17451 | dimension PD(-6:6),FH_T(2),FH_L(2) | |
17452 | ||
17453 | C debug | |
17454 | IF(IDEB(15).GE.10) WRITE(LO,'(1X,A,/10X,I3,2I6,1P3E12.4)') | |
17455 | & 'PHO_CSINT: called with IP, IFP1, IFP2, ECM, PVIR1, PVIR2', | |
17456 | & IP,IFPA,IFPB,ECM,PVIR2A,PVIR2B | |
17457 | ||
17458 | C check currently stored cross sections | |
17459 | IF((IP.EQ.IPFIL).AND.(ECM.EQ.ECMFIL) | |
17460 | & .AND.(PVIR2A.EQ.P2AFIL).AND.(PVIR2B.EQ.P2BFIL) | |
17461 | & .AND.(IFPA.EQ.IFAFIL).AND.(IFPB.EQ.IFBFIL)) THEN | |
17462 | C nothing to calculate | |
17463 | IF(IDEB(15).GE.20) | |
17464 | & WRITE(LO,'(1X,A)') 'PHO_CSINT: nothing done' | |
17465 | RETURN | |
17466 | ELSE | |
17467 | ||
17468 | C copy to local fields | |
17469 | IFPAP(1) = IFPA | |
17470 | IFPAP(2) = IFPB | |
17471 | IHEL(1) = IHLA | |
17472 | IHEL(2) = IHLB | |
17473 | PVIRT(1) = PVIR2A | |
17474 | PVIRT(2) = PVIR2B | |
17475 | ||
17476 | C load cross sections from interpolation table | |
17477 | IF(ECM.LE.SIGECM(IP,1)) THEN | |
17478 | I1 = 1 | |
17479 | I2 = 2 | |
17480 | ELSE IF(ECM.LE.SIGECM(IP,ISIMAX)) THEN | |
17481 | DO 50 I=2,ISIMAX | |
17482 | IF(ECM.LE.SIGECM(IP,I)) GOTO 200 | |
17483 | 50 CONTINUE | |
17484 | 200 CONTINUE | |
17485 | I1 = I-1 | |
17486 | I2 = I | |
17487 | ELSE | |
17488 | WRITE(LO,'(/1X,A,2E12.3)') | |
17489 | & 'PHO_CSINT: too high energy',ECM,SIGECM(IP,ISIMAX) | |
17490 | CALL PHO_PREVNT(-1) | |
17491 | I1 = ISIMAX-1 | |
17492 | I2 = ISIMAX | |
17493 | ENDIF | |
17494 | FAC2=0.D0 | |
17495 | IF(I1.NE.I2) FAC2=LOG(ECM/SIGECM(IP,I1)) | |
17496 | & /LOG(SIGECM(IP,I2)/SIGECM(IP,I1)) | |
17497 | FAC1=1.D0-FAC2 | |
17498 | ||
17499 | C cross section dependence on photon virtualities | |
17500 | DO 140 K=1,2 | |
17501 | FSUP(K) = 1.D0 | |
17502 | FSUD(K) = 1.D0 | |
17503 | FSUH(K) = 1.D0 | |
17504 | IF(IFPAP(K).EQ.22) THEN | |
17505 | IF(ISWMDL(10).GE.1) THEN | |
17506 | FSUP(K) = 0.D0 | |
17507 | FSUT(K) = 0.D0 | |
17508 | FSUL(K) = 0.D0 | |
17509 | FSUH(K) = 0.D0 | |
17510 | C GVDM factors for transverse/longitudinal photons | |
17511 | DO 150 I=1,3 | |
17512 | FSUT(K) = FSUT(K)+PARMDL(26+I) | |
17513 | & /(1.D0+PVIRT(K)/PARMDL(30+I))**2 | |
17514 | FSUL(K) = FSUL(K) | |
17515 | & +PARMDL(26+I)*PVIRT(K)/(4.D0*PARMDL(30+I)) | |
17516 | & /(1.D0+PVIRT(K)/PARMDL(30+I))**2 | |
17517 | 150 CONTINUE | |
17518 | FSUT(K) = FSUT(K)+PARMDL(30)/(1.D0+PVIRT(K)/PARMDL(34)) | |
17519 | C transverse part | |
17520 | IF((ABS(IHEL(K)).EQ.1).OR.(ISWMDL(10).EQ.1)) THEN | |
17521 | FSUP(K) = FSUT(K) | |
17522 | FSUH(K) = FSUT(K)/(FSUT(K)+FSUL(K)) | |
17523 | C diffraction of trans. photons corresponds mainly to leading twist | |
17524 | FSUD(K) = 1.D0 | |
17525 | ENDIF | |
17526 | C longitudinal (scalar) part | |
17527 | IF((IHEL(K).LE.0).OR.(ISWMDL(10).EQ.1)) THEN | |
17528 | FSUP(K) = FSUP(K)+FSUL(K) | |
17529 | FSUH(K) = FSUH(K)+FSUL(K)/(FSUT(K)+FSUL(K)) | |
17530 | C diffraction of long. photons corresponds mainly to higher twist | |
17531 | FSUD(K) = 0.5D0*LOG(((ECM*PARMDL(45))**2+PVIRT(K)) | |
17532 | & /((0.765D0+PARMDL(46))**2+PVIRT(K))) | |
17533 | & /LOG(ECM*PARMDL(45)/(0.765D0+PARMDL(46))) | |
17534 | ENDIF | |
17535 | C debug output | |
17536 | if(ideb(15).ge.10) then | |
17537 | WRITE(LO,'(1x,2a,2i3,/,5x,1p5e12.4)') 'PHO_CSINT: ', | |
17538 | & 'side,helicity,F_tran,F_long,F_eff,F_hard,F_diff', | |
17539 | & K,IHEL(K),FSUT(K),FSUL(K),FSUP(K),FSUH(K),FSUD(K) | |
17540 | endif | |
17541 | ENDIF | |
17542 | ENDIF | |
17543 | 140 CONTINUE | |
17544 | ||
17545 | FACP = FSUP(1)*FSUP(2) | |
17546 | FACH = FSUH(1)*FSUH(2) | |
17547 | FACD = FSUD(1)*FSUD(2) | |
17548 | ||
17549 | C matching of model cross section to F2(x,Q2,P2) in limit of Q2 >> P2 | |
17550 | ||
17551 | if((IFPAP(1).eq.22).and.(IFPAP(2).eq.22) | |
17552 | & .and.(IPAMDL(117).gt.0)) then | |
17553 | C check kinematic limit | |
17554 | Q2_max = max(PVIRT(1),PVIRT(2)) | |
17555 | Q2_min = min(PVIRT(1),PVIRT(2)) | |
17556 | if((Q2_max.gt.1.D0).and.(Q2_min.lt.1.D0)) then | |
17557 | ||
17558 | C calculate F2 from current parton density | |
17559 | if(PVIRT(1).gt.PVIRT(2)) then | |
17560 | K = 2 | |
17561 | else | |
17562 | K = 1 | |
17563 | endif | |
17564 | Q2 = Q2_max | |
17565 | P2 = Q2_min | |
17566 | X = Q2/(ECM**2+Q2+P2) | |
17567 | call pho_actpdf(IFPAP(K),K) | |
17568 | call pho_pdf(K,X,Q2,P2,PD) | |
17569 | C light quark contribution | |
17570 | F2_light = 0.D0 | |
17571 | do j=1,3 | |
17572 | F2_light = F2_light+Q_ch2(j)*(PD(j)+PD(-j)) | |
17573 | enddo | |
17574 | C heavy quark contribution | |
17575 | call pho_qpmpdf(4,X,Q2,0.D0,P2,xpdf_c) | |
17576 | F2_c = 2.D0*4.D0/9.D0*xpdf_c | |
17577 | F2 = (F2_light+F2_c) | |
17578 | ||
17579 | C calculate model prediction | |
17580 | SIGTOT = FAC2*SIGTAB(IP,1,I2)+FAC1*SIGTAB(IP,1,I1) | |
17581 | SIGINE = FAC2*SIGTAB(IP,28,I2)+FAC1*SIGTAB(IP,28,I1) | |
17582 | CALL PHO_HARINT(IP,ECM,0.D0,0.D0,0,Max_pro_2,3,4,1) | |
17583 | ||
17584 | if(ISWMDL(10).ge.2) then | |
17585 | ||
17586 | C calculate all helicity combinations | |
17587 | if(IPAMDL(115).eq.0) then | |
17588 | SIGDIH = HSig(14) | |
17589 | SIGSRH(1) = HSig(10)+HSig(11) | |
17590 | SIGSRH(2) = HSig(12)+HSig(13) | |
17591 | SIGtmp = SIGTOT-SIGDIH-SIGSRH(1)-SIGSRH(2) | |
17592 | C photon helicity factors | |
17593 | FH_T(1) = FSUT(1)/(FSUT(1)+FSUL(1)) | |
17594 | FH_L(1) = 1.D0-FH_T(1) | |
17595 | FH_T(2) = FSUT(2)/(FSUT(2)+FSUL(2)) | |
17596 | FH_L(2) = 1.D0-FH_T(2) | |
17597 | SIG_TT = SIGtmp*FSUT(1)*FSUT(2) | |
17598 | & + SIGDIH*FH_T(1)*FH_T(2) | |
17599 | & + SIGSRH(1)*FH_T(1)*FSUT(2) | |
17600 | & + SIGSRH(2)*FSUT(1)*FH_T(2) | |
17601 | SIG_TL = SIGtmp*FSUT(1)*FSUL(2) | |
17602 | & + SIGDIH*FH_T(1)*FH_L(2) | |
17603 | & + SIGSRH(1)*FH_T(1)*FSUL(2) | |
17604 | & + SIGSRH(2)*FSUT(1)*FH_L(2) | |
17605 | SIG_LT = SIGtmp*FSUL(1)*FSUT(2) | |
17606 | & + SIGDIH*FH_L(1)*FH_T(2) | |
17607 | & + SIGSRH(1)*FH_L(1)*FSUT(2) | |
17608 | & + SIGSRH(2)*FSUL(1)*FH_T(2) | |
17609 | SIG_LL = SIGtmp*FSUL(1)*FSUL(2) | |
17610 | & + SIGDIH*FH_L(1)*FH_L(2) | |
17611 | & + SIGSRH(1)*FH_L(1)*FSUL(2) | |
17612 | & + SIGSRH(2)*FSUL(1)*FH_L(2) | |
17613 | else | |
17614 | C use explicit PDF virtuality dependence (pre-tabulated) | |
17615 | SIGDIH = HSig(14) | |
17616 | SIGSRH(1) = HSig(10)+HSig(11) | |
17617 | SIGSRH(2) = HSig(12)+HSig(13) | |
17618 | SIGtmp = SIGTOT-SIGDIH-SIGSRH(1)-SIGSRH(2) | |
ecf67adb | 17619 | WRITE(LO,*) ' PHO_CSINT: invalid option for F2 matching' |
9aaba0d6 | 17620 | stop |
17621 | * CALL PHO_HARINT(IP,ECM,PVIRT(1),PVIRT(2),0, | |
17622 | * & Max_pro_2,3,4,1) | |
17623 | * SIG_TT = SIGtmp*FSUT(1)*FSUT(2) | |
17624 | * & + HSig(10)+HSig(12)+HSig(14)+HSig(16)+HSig(18) | |
17625 | * SIG_TL = SIGtmp*FSUT(1)*FSUL(2) | |
17626 | * & + HSig(10)+HSig(12)+HSig(14)+HSig(16)+HSig(19) | |
17627 | * SIG_LT = SIGtmp*FSUL(1)*FSUT(2) | |
17628 | * & + HSig(11)+HSig(13)+HSig(15)+HSig(17)+HSig(20) | |
17629 | * SIG_LL = SIGtmp*FSUL(1)*FSUL(2) | |
17630 | * & + HSig(11)+HSig(13)+HSig(15)+HSig(17)+HSig(21) | |
17631 | endif | |
17632 | Xnu = Ecm*Ecm+Q2+P2 | |
17633 | F2_fac = Q2*Xnu/sqrt(Xnu*Xnu-Q2*P2)/(4.D0*Pi*Pi) | |
17634 | & *137.D0/GeV2mb | |
17635 | if(K.eq.2) then | |
17636 | F2m = F2_fac*(SIG_TT+SIG_LT-0.5D0*SIG_TL-0.5D0*SIG_LL) | |
17637 | F2s = F2_fac*SIGtmp*(FSUT(1)*FSUT(2)+FSUL(1)*FSUT(2) | |
17638 | & -0.5D0*FSUT(1)*FSUL(2)-0.5D0*FSUL(1)*FSUL(2)) | |
17639 | else | |
17640 | F2m = F2_fac*(SIG_TT+SIG_TL-0.5D0*SIG_LT-0.5D0*SIG_LL) | |
17641 | F2s = F2_fac*SIGtmp*(FSUT(1)*FSUT(2)+FSUT(1)*FSUL(2) | |
17642 | & -0.5D0*FSUL(1)*FSUT(2)-0.5D0*FSUL(1)*FSUL(2)) | |
17643 | endif | |
17644 | ||
17645 | else | |
17646 | ||
17647 | C assume sig_eff = sigtot | |
17648 | SIGDIH = HSig(14) | |
17649 | SIGSRH(1) = HSig(10)+HSig(11) | |
17650 | SIGSRH(2) = HSig(12)+HSig(13) | |
17651 | SIGtmp = SIGTOT-SIGSRH(1)-SIGSRH(2)-SIGDIH | |
17652 | SIGeff = SIGtmp*FSUP(1)*FSUP(2) | |
17653 | & +SIGSRH(1)*FSUP(2)+SIGSRH(2)*FSUP(1)+SIGDIH | |
17654 | Xnu = Ecm*Ecm+Q2+P2 | |
17655 | F2_fac = Q2*Xnu/sqrt(Xnu*Xnu-Q2*P2)/(4.D0*Pi*Pi) | |
17656 | & *137.D0/GeV2mb | |
17657 | F2m = F2_fac*SIGeff | |
17658 | F2s = F2_fac*SIGtmp*FSUP(1)*FSUP(2) | |
17659 | endif | |
ecf67adb | 17660 | * WRITE(LO,*) ' PHO_CSINT: Q2_1,Q2_2,W ',PVIRT(1),PVIRT(2),Ecm |
17661 | * WRITE(LO,*) ' PHO_CSINT: F2_mod,F2_pdf,mod/pdf ',F2m,F2,F2m/F2 | |
9aaba0d6 | 17662 | |
17663 | C global factor to re-scale suppression of soft contributions | |
17664 | Fcorr = (F2-F2m+F2s)/F2s | |
ecf67adb | 17665 | * WRITE(LO,*) ' PHO_CSINT: re-scaling factor: ',Fcorr,FACP*Fcorr |
9aaba0d6 | 17666 | FACP = FACP*Fcorr |
17667 | ||
17668 | endif | |
17669 | endif | |
17670 | ||
17671 | SIGTOT = (FAC2*SIGTAB(IP,1,I2)+FAC1*SIGTAB(IP,1,I1))*FACP | |
17672 | SIGINE = (FAC2*SIGTAB(IP,28,I2)+FAC1*SIGTAB(IP,28,I1))*FACP | |
17673 | SIGELA = (FAC2*SIGTAB(IP,2,I2)+FAC1*SIGTAB(IP,2,I1))*FACP | |
17674 | J = 2 | |
17675 | DO 5 I=0,4 | |
17676 | DO 6 K=0,4 | |
17677 | J = J+1 | |
17678 | SIGVM(I,K) = (FAC2*SIGTAB(IP,J,I2)+FAC1*SIGTAB(IP,J,I1)) | |
17679 | & *FACP**2 | |
17680 | 6 CONTINUE | |
17681 | 5 CONTINUE | |
17682 | ||
17683 | SIGDIR = FAC2*SIGTAB(IP,29,I2)+FAC1*SIGTAB(IP,29,I1) | |
17684 | SIGHAR = FAC2*SIGTAB(IP,58,I2)+FAC1*SIGTAB(IP,58,I1) | |
17685 | C suppression of multi-pomeron graphs (diffraction) | |
17686 | SIGLSD(1) = (FAC2*SIGTAB(IP,30,I2)+FAC1*SIGTAB(IP,30,I1)) | |
17687 | & *FACP*FSUP(2)*FSUD(1) | |
17688 | SIGLSD(2) = (FAC2*SIGTAB(IP,31,I2)+FAC1*SIGTAB(IP,31,I1)) | |
17689 | & *FACP*FSUP(1)*FSUD(2) | |
17690 | SIGHSD(1) = (FAC2*SIGTAB(IP,32,I2)+FAC1*SIGTAB(IP,32,I1)) | |
17691 | & *FACP*FSUP(2)*FSUD(1) | |
17692 | SIGHSD(2) = (FAC2*SIGTAB(IP,33,I2)+FAC1*SIGTAB(IP,33,I1)) | |
17693 | & *FACP*FSUP(1)*FSUD(2) | |
17694 | SIGLDD = (FAC2*SIGTAB(IP,34,I2)+FAC1*SIGTAB(IP,34,I1)) | |
17695 | & *FACP**2*FACD | |
17696 | SIGHDD = (FAC2*SIGTAB(IP,35,I2)+FAC1*SIGTAB(IP,35,I1))*FACP | |
17697 | SIGCDF(0) = (FAC2*SIGTAB(IP,36,I2)+FAC1*SIGTAB(IP,36,I1)) | |
17698 | & *FACP**2 | |
17699 | SIGTR1(1) = (FAC2*SIGTAB(IP,60,I2)+FAC1*SIGTAB(IP,60,I1)) | |
17700 | & *FACP*FSUP(2)*FSUD(1) | |
17701 | SIGTR1(2) = (FAC2*SIGTAB(IP,61,I2)+FAC1*SIGTAB(IP,61,I1)) | |
17702 | & *FACP*FSUP(2)*FSUD(1) | |
17703 | SIGTR2(1) = (FAC2*SIGTAB(IP,62,I2)+FAC1*SIGTAB(IP,62,I1)) | |
17704 | & *FACP*FSUP(1)*FSUD(2) | |
17705 | SIGTR2(2) = (FAC2*SIGTAB(IP,63,I2)+FAC1*SIGTAB(IP,63,I1)) | |
17706 | & *FACP*FSUP(1)*FSUD(2) | |
17707 | SIGLOO = (FAC2*SIGTAB(IP,64,I2)+FAC1*SIGTAB(IP,64,I1))*FACP | |
17708 | SIGDPO(1) = (FAC2*SIGTAB(IP,65,I2)+FAC1*SIGTAB(IP,65,I1)) | |
17709 | & *FACP**2 | |
17710 | SIGDPO(2) = (FAC2*SIGTAB(IP,66,I2)+FAC1*SIGTAB(IP,66,I1)) | |
17711 | & *FACP**2 | |
17712 | SIGDPO(3) = (FAC2*SIGTAB(IP,67,I2)+FAC1*SIGTAB(IP,67,I1)) | |
17713 | & *FACP**2 | |
17714 | SIGDPO(4) = (FAC2*SIGTAB(IP,68,I2)+FAC1*SIGTAB(IP,68,I1)) | |
17715 | & *FACP**2 | |
17716 | ||
17717 | C corrections due to photon virtuality dependence of PDFs | |
17718 | if(iswmdl(2).eq.1) then | |
17719 | CALL PHO_HARINT(IP,ECM,0.D0,0.D0,0,Max_pro_2,3,4,1) | |
17720 | C minimum bias event generation | |
17721 | IF(IPAMDL(115).GE.1) THEN | |
17722 | C all the virtuality dependence is given by PDF parametrization | |
17723 | SIGHIN = FAC2*SIGTAB(IP,80,I2)+FAC1*SIGTAB(IP,80,I1) | |
17724 | IF(IPAMDL(116).GE.2) THEN | |
17725 | C direct interaction according to full QPM calculation | |
17726 | SIGDIH = HSig(14) | |
17727 | SIGSRH(1) = HSig(10)+HSig(11) | |
17728 | SIGSRH(2) = HSig(12)+HSig(13) | |
17729 | ELSE | |
17730 | C direct interaction suppressed according to helicity factor | |
17731 | SIGDIH = HSig(14)*FACH | |
17732 | SIGSRH(1) = (HSig(10)+HSig(11))*FSUH(1) | |
17733 | SIGSRH(2) = (HSig(12)+HSig(13))*FSUH(2) | |
17734 | ENDIF | |
ecf67adb | 17735 | WRITE(LO,*) ' PHO_CSINT: option not supported yet' |
9aaba0d6 | 17736 | stop |
17737 | ELSE | |
17738 | C rescale relevant hard processes | |
17739 | SIGDIH = HSig(14) | |
17740 | SIGSRH(1) = HSig(10)+HSig(11) | |
17741 | SIGSRH(2) = HSig(12)+HSig(13) | |
17742 | SIGtmp = SIGINE-(SIGDIH+SIGSRH(1)+SIGSRH(2))*FACP | |
17743 | SIGDIR = HSig(14)*FACH+SIGSRH(1)*FSUH(1)*FSUP(2) | |
17744 | & +SIGSRH(2)*FSUP(1)*FSUH(2) | |
17745 | SIGINE = SIGtmp+SIGDIR | |
17746 | SIGTOT = SIGINE+SIGELA | |
17747 | ENDIF | |
17748 | else | |
17749 | C only hard interactions | |
17750 | CALL PHO_HARINT(IP,ECM,0.D0,0.D0,0,Max_pro_2,3,4,1) | |
17751 | SIGSRH(1) = (HSig(10)+HSig(11))*FSUH(1) | |
17752 | SIGSRH(2) = (HSig(12)+HSig(13))*FSUH(2) | |
17753 | SIGDIR = HSig(14)+SIGSRH(1)+SIGSRH(2) | |
17754 | SIGHAR = HSig(9)*FACH | |
17755 | endif | |
17756 | ||
17757 | SIG1SO = (FAC2*SIGTAB(IP,37,I2)+FAC1*SIGTAB(IP,37,I1))*FACP | |
17758 | SIG1HA = (FAC2*SIGTAB(IP,38,I2)+FAC1*SIGTAB(IP,38,I1))*FACH | |
17759 | SLOEL = FAC2*SIGTAB(IP,39,I2)+FAC1*SIGTAB(IP,39,I1) | |
17760 | J = 39 | |
17761 | DO 9 I=1,4 | |
17762 | DO 10 K=1,4 | |
17763 | J = J+1 | |
17764 | SLOVM(I,K) = FAC2*SIGTAB(IP,J,I2)+FAC1*SIGTAB(IP,J,I1) | |
17765 | 10 CONTINUE | |
17766 | 9 CONTINUE | |
17767 | SIGPOM = (FAC2*SIGTAB(IP,56,I2)+FAC1*SIGTAB(IP,56,I1))*FACP | |
17768 | SIGREG = (FAC2*SIGTAB(IP,57,I2)+FAC1*SIGTAB(IP,57,I1))*FACP | |
17769 | ||
17770 | IPFIL = IP | |
17771 | IFAFIL = IFPA | |
17772 | IFBFIL = IFPB | |
17773 | ECMFIL = ECM | |
17774 | P2AFIL = PVIR2A | |
17775 | P2BFIL = PVIR2B | |
17776 | ||
17777 | IF(IDEB(15).GE.20) | |
17778 | & WRITE(LO,'(1X,A)') 'PHO_CSINT: cross sections calculated' | |
17779 | ||
17780 | ENDIF | |
17781 | ||
17782 | END | |
17783 | ||
17784 | *$ CREATE PHO_PRIMKT.FOR | |
17785 | *COPY PHO_PRIMKT | |
17786 | CDECK ID>, PHO_PRIMKT | |
17787 | SUBROUTINE PHO_PRIMKT(IMODE,IF,IL,PTCUT,IREJ) | |
17788 | C*********************************************************************** | |
17789 | C | |
17790 | C give primordial kt to partons entering hard scatterings and | |
17791 | C remants connected to hard parton-parton interactions by color flow | |
17792 | C | |
17793 | C input: IMODE -2 output of statistics | |
17794 | C -1 initialization | |
17795 | C 1 sampling of primordial kt | |
17796 | C IF first entry in /POEVT1/ to check | |
17797 | C IL last entry in /POEVT1/ to check | |
17798 | C PTCUT current value of PTCUT to distinguish | |
17799 | C between soft and hard | |
17800 | C | |
17801 | C output: IREJ 0 success | |
17802 | C 1 failure | |
17803 | C | |
17804 | C*********************************************************************** | |
17805 | IMPLICIT NONE | |
17806 | SAVE | |
17807 | ||
17808 | DOUBLE PRECISION DEPS | |
17809 | PARAMETER ( DEPS = 1.D-15 ) | |
17810 | ||
17811 | INTEGER IMODE,IF,IL,IREJ | |
17812 | DOUBLE PRECISION PTCUT | |
17813 | ||
17814 | C input/output channels | |
17815 | INTEGER LI,LO | |
17816 | COMMON /POINOU/ LI,LO | |
17817 | C event debugging information | |
17818 | INTEGER NMAXD | |
17819 | PARAMETER (NMAXD=100) | |
17820 | INTEGER IDEB,KSPOM,KHPOM,KSREG,KHDIR,KACCEP,KSTRG,KHTRG,KSLOO, | |
17821 | & KHLOO,KSDPO,KHDPO,KEVENT,KSOFT,KHARD | |
17822 | COMMON /PODEBG/ IDEB(NMAXD),KSPOM,KHPOM,KSREG,KHDIR,KACCEP,KSTRG, | |
17823 | & KHTRG,KSLOO,KHLOO,KSDPO,KHDPO,KEVENT,KSOFT,KHARD | |
17824 | C model switches and parameters | |
17825 | CHARACTER*8 MDLNA | |
17826 | INTEGER ISWMDL,IPAMDL | |
17827 | DOUBLE PRECISION PARMDL | |
17828 | COMMON /POMDLS/ MDLNA(50),ISWMDL(50),PARMDL(400),IPAMDL(400) | |
17829 | C some constants | |
17830 | DOUBLE PRECISION PI,PI2,PI4,GEV2MB,Q_ch,Q_ch2,Q_ch4 | |
17831 | COMMON /POCONS/ PI,PI2,PI4,GEV2MB, | |
17832 | & Q_ch(-6:6),Q_ch2(-6:6),Q_ch4(-6:6) | |
17833 | C data of c.m. system of Pomeron / Reggeon exchange | |
17834 | INTEGER NPOSP,IDPDG1,IDBAM1,IDPDG2,IDBAM2 | |
17835 | DOUBLE PRECISION ECMP,PCMP,PMASSP,PVIRTP,GAMBEP, | |
17836 | & SIDP,CODP,SIFP,COFP | |
17837 | COMMON /POPCMS/ ECMP,PCMP,PMASSP(2),PVIRTP(2),GAMBEP(4), | |
17838 | & SIDP,CODP,SIFP,COFP,NPOSP(2), | |
17839 | & IDPDG1,IDBAM1,IDPDG2,IDBAM2 | |
17840 | C hard scattering data | |
17841 | INTEGER MSCAHD | |
17842 | PARAMETER ( MSCAHD = 50 ) | |
17843 | INTEGER LSCAHD,LSC1HD,LSIDX, | |
17844 | & NINHD,N0INHD,NIVAL,N0IVAL,NOUTHD,NBRAHD,NPROHD | |
17845 | DOUBLE PRECISION PPH,PTHD,ETAHD,Q2SCA,PDFVA,XHD,VHD,X0HD | |
17846 | COMMON /POHSLT/ LSCAHD,LSC1HD,LSIDX(MSCAHD), | |
17847 | & PPH(8*MSCAHD,2),PTHD(MSCAHD),ETAHD(MSCAHD,2), | |
17848 | & Q2SCA(MSCAHD,2),PDFVA(MSCAHD,2), | |
17849 | & XHD(MSCAHD,2),VHD(MSCAHD),X0HD(MSCAHD,2), | |
17850 | & NINHD(MSCAHD,2),N0INHD(MSCAHD,2), | |
17851 | & NIVAL(MSCAHD,2),N0IVAL(MSCAHD,2), | |
17852 | & NOUTHD(MSCAHD,2),NBRAHD(MSCAHD,2),NPROHD(MSCAHD) | |
17853 | C standard particle data interface | |
17854 | INTEGER NMXHEP | |
17855 | PARAMETER (NMXHEP=4000) | |
17856 | INTEGER NEVHEP,NHEP,ISTHEP,IDHEP,JMOHEP,JDAHEP | |
17857 | DOUBLE PRECISION PHEP,VHEP | |
17858 | COMMON /POEVT1/ NEVHEP,NHEP,ISTHEP(NMXHEP),IDHEP(NMXHEP), | |
17859 | & JMOHEP(2,NMXHEP),JDAHEP(2,NMXHEP),PHEP(5,NMXHEP), | |
17860 | & VHEP(4,NMXHEP) | |
17861 | C extension to standard particle data interface (PHOJET specific) | |
17862 | INTEGER IMPART,IPHIST,ICOLOR | |
17863 | COMMON /POEVT2/ IMPART(NMXHEP),IPHIST(2,NMXHEP),ICOLOR(2,NMXHEP) | |
17864 | ||
17865 | DOUBLE PRECISION PTS,XP,XP2,POLD,PNEW,GA,PP | |
17866 | DIMENSION PTS(0:2,5),XP(5), | |
17867 | & XP2(5,2),POLD(2,2),PNEW(4,2),GA(4),PP(4) | |
17868 | ||
17869 | INTEGER IROTT,IBALT,IBAL,IV,IV2,IRMAX | |
17870 | ||
17871 | PARAMETER (IRMAX=200) | |
17872 | DIMENSION IROTT(IRMAX),IBALT(5,2),IBAL(2),IV(5),IV2(5,2) | |
17873 | ||
17874 | DOUBLE PRECISION SI,EI,SF,EF,PTOT,EE,XX,YY,ZZ,ANORF,FAC,DEL,PT2, | |
17875 | & DEL2,GAE,GAZ,SID,COD,SIF,COF,ESUM | |
17876 | INTEGER IROT,I,J,K,NHD,ISTART,INEXT,ICOM | |
17877 | ||
17878 | C debug output | |
17879 | IF(IDEB(10).GE.10) WRITE(LO,'(1X,A,3I4,1P,E11.3)') | |
17880 | & 'PHO_PRIMKT: called with IMODE,IF,IL,PTCUT', | |
17881 | & IMODE,IF,IL,PTCUT | |
17882 | ||
17883 | C give primordial kt to partons engaged in a hard scattering | |
17884 | ||
17885 | IF(IMODE.EQ.1) THEN | |
17886 | ||
17887 | ISTART = IF | |
17888 | ||
17889 | 100 CONTINUE | |
17890 | ||
17891 | NHD = 0 | |
17892 | IBAL(1) = 0 | |
17893 | IBAL(2) = 0 | |
17894 | IROT = 0 | |
17895 | ICOM = 0 | |
17896 | DO 110 I=ISTART,IL | |
17897 | IF(ISTHEP(I).EQ.25) THEN | |
17898 | C hard scattering number | |
17899 | NHD = IPHIST(1,I+1) | |
17900 | ICOM = I | |
17901 | K = LSIDX(NHD/100) | |
17902 | C calculate momenta of incoming partons | |
17903 | POLD(1,1) = XHD(K,1)*ECMP/2.D0 | |
17904 | POLD(2,1) = POLD(1,1) | |
17905 | POLD(1,2) = -XHD(K,2)*ECMP/2.D0 | |
17906 | POLD(2,2) = -POLD(1,2) | |
17907 | ISTART = I+3 | |
17908 | GOTO 150 | |
17909 | ENDIF | |
17910 | 110 CONTINUE | |
17911 | RETURN | |
17912 | ||
17913 | 150 CONTINUE | |
17914 | ||
17915 | C search for partons involved in hard interaction | |
17916 | INEXT = 0 | |
17917 | IROT = 0 | |
17918 | DO 500 I=ISTART,IL | |
17919 | IF(ABS(ISTHEP(I)).EQ.1) THEN | |
17920 | C hard scatterd partons (including ISR) | |
17921 | IF((IPHIST(1,I).EQ.-NHD) | |
17922 | & .OR.(IPHIST(1,I).EQ.NHD+1) | |
17923 | & .OR.(IPHIST(1,I).EQ.NHD+2)) THEN | |
17924 | IROT = IROT+1 | |
17925 | IF(IROT.GT.IRMAX) THEN | |
17926 | WRITE(LO,'(1X,/,2A,2I5)') 'PHO_PRIMKT: ', | |
17927 | & 'no memory left in IROTT, event rejected (max/IROT)', | |
17928 | & IRMAX,IROT | |
17929 | CALL PHO_PREVNT(0) | |
17930 | IREJ = 1 | |
17931 | RETURN | |
17932 | ENDIF | |
17933 | IROTT(IROT) = I | |
17934 | C hard remnant | |
17935 | ELSE IF(IPHIST(1,I).EQ.NHD) THEN | |
17936 | IF(PHEP(3,I).GT.0.D0) THEN | |
17937 | J = 1 | |
17938 | ELSE | |
17939 | J = 2 | |
17940 | ENDIF | |
17941 | IBAL(J) = IBAL(J)+1 | |
17942 | IBALT(IBAL(J),J) = I | |
17943 | XP2(IBAL(J),J) = PHEP(3,I)/ECMP | |
17944 | IF(ISWMDL(24).EQ.0) THEN | |
17945 | IV2(IBAL(J),J) = 0 | |
17946 | IF(IDHEP(I).NE.21) IV2(IBAL(J),J) = ICOLOR(2,I) | |
17947 | ELSE IF(ISWMDL(24).EQ.1) THEN | |
17948 | IV2(IBAL(J),J) = -1 | |
17949 | ELSE | |
17950 | IV2(IBAL(J),J) = 1 | |
17951 | ENDIF | |
17952 | ENDIF | |
17953 | C possibly further hard scattering | |
17954 | ELSE IF(ISTHEP(I).EQ.25) THEN | |
17955 | INEXT = 1 | |
17956 | ISTART = I | |
17957 | GOTO 550 | |
17958 | ENDIF | |
17959 | 500 CONTINUE | |
17960 | 550 CONTINUE | |
17961 | ||
17962 | C debug output | |
17963 | if(IDEB(10).ge.15) then | |
17964 | WRITE(LO,'(1X,2A,I4)') 'PHO_PRIMKT: ', | |
17965 | & 'hard scattering number: ',NHD/100 | |
17966 | WRITE(LO,'(1X,2A,I5)') 'PHO_PRIMKT: ', | |
17967 | & 'number of entries to rotate: ',IROT | |
17968 | DO I=1,IROT | |
17969 | WRITE(LO,'(1X,2A,2I5)') 'PHO_PRIMKT: ', | |
17970 | & 'entries to rotate: ',I,IROTT(I) | |
17971 | ENDDO | |
17972 | WRITE(LO,'(1X,2A,2I5)') 'PHO_PRIMKT: ', | |
17973 | & 'number of entries to balance: ',IBAL | |
17974 | DO J=1,2 | |
17975 | DO I=1,IBAL(J) | |
17976 | WRITE(LO,'(1X,2A,I2,2I5)') | |
17977 | & 'PHO_PRIMKT: entries to balance (side,no,line)', | |
17978 | & J,I,IBALT(I,J) | |
17979 | ENDDO | |
17980 | ENDDO | |
17981 | endif | |
17982 | ||
17983 | C incoming partons (comment lines), skip direct interacting particles | |
17984 | DO 120 K=1,2 | |
17985 | IF((IDHEP(ICOM+K).NE.22).AND.(IDHEP(ICOM+K).NE.990)) THEN | |
17986 | IF(PHEP(3,ICOM+K).GT.0.D0) THEN | |
17987 | J = 1 | |
17988 | ELSE | |
17989 | J = 2 | |
17990 | ENDIF | |
17991 | IBAL(J) = IBAL(J)+1 | |
17992 | IBALT(IBAL(J),J) = -ICOM-K | |
17993 | XP2(IBAL(J),J) = POLD(1,J)/ECMP | |
17994 | IV2(IBAL(J),J) = -1 | |
17995 | ENDIF | |
17996 | 120 CONTINUE | |
17997 | ||
17998 | C check consistency | |
17999 | IF((IBAL(1).GT.4).OR.(IBAL(2).GT.4)) THEN | |
18000 | WRITE(LO,'(1X,2A,I10)') 'PHO_PRIMKT: ', | |
18001 | & 'inconsistent hard scattering remnant for event: ',KEVENT | |
18002 | WRITE(LO,'(1X,A,3I4,1P,E11.3)') | |
18003 | & 'PHO_PRIMKT called with IMODE,IF,IL,PTCUT', | |
18004 | & IMODE,IF,IL,PTCUT | |
18005 | WRITE(LO,'(1X,A,I4)') 'hard scattering number: ',NHD/100 | |
18006 | DO 390 I=1,IROT | |
18007 | WRITE(LO,'(1X,A,2I5)') 'entries to rotate',I,IROTT(I) | |
18008 | 390 CONTINUE | |
18009 | DO 392 J=1,2 | |
18010 | DO 395 I=1,IBAL(J) | |
18011 | WRITE(LO,'(1X,A,I2,2I5)') | |
18012 | & 'entries to balance (side,no,line)',J,I,IBALT(I,J) | |
18013 | 395 CONTINUE | |
18014 | 392 CONTINUE | |
18015 | IF(IBAL(1)+IBAL(2).GT.0) CALL PHO_PREVNT(0) | |
18016 | ENDIF | |
18017 | ||
18018 | C calculate primordial kt | |
18019 | ||
18020 | C something to do? | |
18021 | IF((IBAL(1).GT.1).OR.(IBAL(2).GT.1)) THEN | |
18022 | ||
18023 | C add transverse momentum (overwrite /POEVT1/ entries) | |
18024 | DO 200 J=1,2 | |
18025 | IF(IBAL(J).GT.1) THEN | |
18026 | C sample from truncated distribution | |
18027 | K = IBAL(J) | |
18028 | DO 180 I=1,K | |
18029 | IV(I) = IV2(I,J) | |
18030 | XP(I) = XP2(I,J) | |
18031 | 180 CONTINUE | |
18032 | 190 CONTINUE | |
18033 | CALL PHO_SOFTPT(K,PTCUT,PTCUT,XP,IV,PTS) | |
18034 | IF(PTS(0,K).GE.PARMDL(100)) GOTO 190 | |
18035 | C transform incoming partons of hard scattering | |
18036 | DEL = ABS(POLD(1,J))+POLD(2,J) | |
18037 | PT2 = PTS(0,K)**2 | |
18038 | DEL2 = DEL*DEL | |
18039 | PNEW(1,J) = PTS(1,K) | |
18040 | PNEW(2,J) = PTS(2,K) | |
18041 | PNEW(3,J) = (-1)**J*(PT2 - DEL2)/(2.D0*DEL) | |
18042 | PNEW(4,J) = (DEL2 + PT2)/(2.D0*DEL) | |
18043 | C spectator partons | |
18044 | ESUM = 0.D0 | |
18045 | DO 220 I=1,IBAL(J)-1 | |
18046 | K = IBALT(I,J) | |
18047 | PHEP(1,K) = PHEP(1,K)+PTS(1,I) | |
18048 | PHEP(2,K) = PHEP(2,K)+PTS(2,I) | |
18049 | ESUM = ESUM+PHEP(4,K) | |
18050 | 220 CONTINUE | |
18051 | C long. momentum transfer | |
18052 | PP(3) = PNEW(3,J) - POLD(1,J) | |
18053 | PP(4) = PNEW(4,J) - POLD(2,J) | |
18054 | DO 230 I=1,IBAL(J)-1 | |
18055 | K = IBALT(I,J) | |
18056 | FAC = PHEP(4,K)/ESUM | |
18057 | PHEP(3,K) = PHEP(3,K) - FAC*PP(3) | |
18058 | PHEP(4,K) = PHEP(4,K) - FAC*PP(4) | |
18059 | 230 CONTINUE | |
18060 | ||
18061 | C debug output | |
18062 | IF(IDEB(10).GE.15) THEN | |
18063 | WRITE(LO,'(1X,2A,I3,1P,4E11.3)') 'PHO_PRIMKT: ', | |
18064 | & 'old incoming:',J,0.D0,0.D0,(POLD(I,J),I=1,2) | |
18065 | WRITE(LO,'(1X,2A,I3,1P,4E11.3)') 'PHO_PRIMKT: ', | |
18066 | & 'new incoming:',J,(PNEW(I,J),I=1,4) | |
18067 | ENDIF | |
18068 | ||
18069 | ELSE | |
18070 | PNEW(1,J) = 0.D0 | |
18071 | PNEW(2,J) = 0.D0 | |
18072 | PNEW(3,J) = POLD(1,J) | |
18073 | PNEW(4,J) = POLD(2,J) | |
18074 | ENDIF | |
18075 | 200 CONTINUE | |
18076 | ||
18077 | C transformation of hard scattering final states (including ISR) | |
18078 | ||
18079 | C old parton c.m. energy | |
18080 | SI = (POLD(2,1)+POLD(2,2))**2-(POLD(1,1)+POLD(1,2))**2 | |
18081 | EI = SQRT(SI) | |
18082 | C new parton c.m. energy | |
18083 | SF = (PNEW(4,1)+PNEW(4,2))**2-(PNEW(1,1)+PNEW(1,2))**2 | |
18084 | & -(PNEW(2,1)+PNEW(2,2))**2-(PNEW(3,1)+PNEW(3,2))**2 | |
18085 | EF = SQRT(SF) | |
18086 | FAC = EF/EI | |
18087 | C debug output | |
18088 | IF(IDEB(10).GE.25) WRITE(LO,'(1X,A,1P,E12.4)') | |
18089 | & 'PHO_PRIMKT: scaling factor (E-final/E-initial): ',FAC | |
18090 | ||
18091 | C calculate Lorentz transformation | |
18092 | GAZ = -(POLD(1,1)+POLD(1,2))/EI | |
18093 | GAE = (POLD(2,1)+POLD(2,2))/EI | |
18094 | DO 240 I=1,4 | |
18095 | GA(I) = (PNEW(I,1)+PNEW(I,2))/EF | |
18096 | 240 CONTINUE | |
18097 | CALL PHO_ALTRA(GA(4),-GA(1),-GA(2),-GA(3),PNEW(1,1),PNEW(2,1), | |
18098 | & PNEW(3,1),PNEW(4,1),PTOT,PP(1),PP(2),PP(3),PP(4)) | |
18099 | PTOT = MAX(DEPS,PTOT) | |
18100 | COD= PP(3)/PTOT | |
18101 | SID= SQRT(PP(1)**2+PP(2)**2)/PTOT | |
18102 | COF= 1.D0 | |
18103 | SIF= 0.D0 | |
18104 | IF(PTOT*SID.GT.1.D-5) THEN | |
18105 | COF=PP(1)/(SID*PTOT) | |
18106 | SIF=PP(2)/(SID*PTOT) | |
18107 | ANORF=SQRT(COF*COF+SIF*SIF) | |
18108 | COF=COF/ANORF | |
18109 | SIF=SIF/ANORF | |
18110 | ENDIF | |
18111 | ||
18112 | C debug output | |
18113 | C check consistency initial/final configuration before rotation | |
18114 | IF(IDEB(10).GE.25) THEN | |
18115 | WRITE(LO,'(1X,A,1P,4E11.3)') 'PHO_PRIMKT: ini. momentum (1):', | |
18116 | & 0.D0,0.D0,(POLD(I,1)+POLD(I,2),I=1,2) | |
18117 | DO I=1,4 | |
18118 | PP(I) = 0.D0 | |
18119 | ENDDO | |
18120 | DO I=1,IROT | |
18121 | K = IROTT(I) | |
18122 | DO J=1,4 | |
18123 | PP(J) = PP(J)+PHEP(J,K) | |
18124 | ENDDO | |
18125 | ENDDO | |
18126 | WRITE(LO,'(1X,A,1P,4E11.3)') | |
18127 | & 'PHO_PRIMKT: fin. momentum (1):',PP | |
18128 | ENDIF | |
18129 | ||
18130 | C apply rotation/boost to scattered particles | |
18131 | DO 400 I=1,IROT | |
18132 | K = IROTT(I) | |
18133 | DO 350 J=1,4 | |
18134 | PP(J) = FAC*PHEP(J,K) | |
18135 | 350 CONTINUE | |
18136 | CALL PHO_ALTRA(GAE,0.D0,0.D0,GAZ,PP(1),PP(2),PP(3), | |
18137 | & PP(4),PTOT,PHEP(1,K),PHEP(2,K),PHEP(3,K),PHEP(4,K)) | |
18138 | CALL PHO_TRANS(PHEP(1,K),PHEP(2,K),PHEP(3,K), | |
18139 | & COD,SID,COF,SIF,XX,YY,ZZ) | |
18140 | EE = PHEP(4,K) | |
18141 | CALL PHO_ALTRA(GA(4),GA(1),GA(2),GA(3),XX,YY,ZZ,EE,PTOT, | |
18142 | & PHEP(1,K),PHEP(2,K),PHEP(3,K),PHEP(4,K)) | |
18143 | 400 CONTINUE | |
18144 | ||
18145 | C debug output | |
18146 | C check consistency initial/final configuration after rotation | |
18147 | IF(IDEB(10).GE.25) THEN | |
18148 | DO I=1,4 | |
18149 | PP(I) = PNEW(I,1)+PNEW(I,2) | |
18150 | ENDDO | |
18151 | WRITE(LO,'(1X,A,1P,4E11.3)') | |
18152 | & 'PHO_PRIMKT: ini. momentum (2):',PP | |
18153 | DO I=1,4 | |
18154 | PP(I) = 0.D0 | |
18155 | ENDDO | |
18156 | DO I=1,IROT | |
18157 | K = IROTT(I) | |
18158 | DO J=1,4 | |
18159 | PP(J) = PP(J)+PHEP(J,K) | |
18160 | ENDDO | |
18161 | ENDDO | |
18162 | WRITE(LO,'(1X,A,1P,4E11.3)') | |
18163 | & 'PHO_PRIMKT: fin. momentum (2):',PP | |
18164 | ENDIF | |
18165 | ||
18166 | ENDIF | |
18167 | ||
18168 | IF(INEXT.EQ.1) GOTO 100 | |
18169 | ||
18170 | C initialization | |
18171 | ||
18172 | ELSE IF(IMODE.EQ.-1) THEN | |
18173 | ||
18174 | C output of statistics etc. | |
18175 | ||
18176 | ELSE IF(IMODE.EQ.-2) THEN | |
18177 | ||
18178 | C something wrong | |
18179 | ||
18180 | ELSE | |
18181 | WRITE(LO,'(/1X,A,I4)') | |
18182 | & 'PHO_PRIMKT:ERROR: invalid value of IMODE:',IMODE | |
18183 | CALL PHO_ABORT | |
18184 | ENDIF | |
18185 | ||
18186 | END | |
18187 | ||
18188 | *$ CREATE PHO_PARTPT.FOR | |
18189 | *COPY PHO_PARTPT | |
18190 | CDECK ID>, PHO_PARTPT | |
18191 | SUBROUTINE PHO_PARTPT(IMODE,IF,IL,PTCUT,IREJ) | |
18192 | C******************************************************************** | |
18193 | C | |
18194 | C assign to soft partons | |
18195 | C | |
18196 | C input: IMODE -2 output of statistics | |
18197 | C -1 initialization | |
18198 | C 0 sampling of pt for soft partons belonging to | |
18199 | C soft Pomerons | |
18200 | C 1 sampling of pt for soft partons belonging to | |
18201 | C hard Pomerons | |
18202 | C IF first entry in /POEVT1/ to check | |
18203 | C IL last entry in /POEVT1/ to check | |
18204 | C PTCUT current value of PTCUT to distinguish | |
18205 | C between soft and hard | |
18206 | C | |
18207 | C output: IREJ 0 success | |
18208 | C 1 failure | |
18209 | C | |
18210 | C (soft pt is sampled by call to PHO_SOFTPT) | |
18211 | C | |
18212 | C******************************************************************** | |
18213 | IMPLICIT DOUBLE PRECISION (A-H,O-Z) | |
18214 | SAVE | |
18215 | ||
18216 | PARAMETER ( DEPS = 1.D-15 ) | |
18217 | ||
18218 | INTEGER IMODE,IF,IL,IREJ | |
18219 | DOUBLE PRECISION PTCUT | |
18220 | ||
18221 | C input/output channels | |
18222 | INTEGER LI,LO | |
18223 | COMMON /POINOU/ LI,LO | |
18224 | C event debugging information | |
18225 | INTEGER NMAXD | |
18226 | PARAMETER (NMAXD=100) | |
18227 | INTEGER IDEB,KSPOM,KHPOM,KSREG,KHDIR,KACCEP,KSTRG,KHTRG,KSLOO, | |
18228 | & KHLOO,KSDPO,KHDPO,KEVENT,KSOFT,KHARD | |
18229 | COMMON /PODEBG/ IDEB(NMAXD),KSPOM,KHPOM,KSREG,KHDIR,KACCEP,KSTRG, | |
18230 | & KHTRG,KSLOO,KHLOO,KSDPO,KHDPO,KEVENT,KSOFT,KHARD | |
18231 | C model switches and parameters | |
18232 | CHARACTER*8 MDLNA | |
18233 | INTEGER ISWMDL,IPAMDL | |
18234 | DOUBLE PRECISION PARMDL | |
18235 | COMMON /POMDLS/ MDLNA(50),ISWMDL(50),PARMDL(400),IPAMDL(400) | |
18236 | C some constants | |
18237 | DOUBLE PRECISION PI,PI2,PI4,GEV2MB,Q_ch,Q_ch2,Q_ch4 | |
18238 | COMMON /POCONS/ PI,PI2,PI4,GEV2MB, | |
18239 | & Q_ch(-6:6),Q_ch2(-6:6),Q_ch4(-6:6) | |
18240 | C data of c.m. system of Pomeron / Reggeon exchange | |
18241 | INTEGER NPOSP,IDPDG1,IDBAM1,IDPDG2,IDBAM2 | |
18242 | DOUBLE PRECISION ECMP,PCMP,PMASSP,PVIRTP,GAMBEP, | |
18243 | & SIDP,CODP,SIFP,COFP | |
18244 | COMMON /POPCMS/ ECMP,PCMP,PMASSP(2),PVIRTP(2),GAMBEP(4), | |
18245 | & SIDP,CODP,SIFP,COFP,NPOSP(2), | |
18246 | & IDPDG1,IDBAM1,IDPDG2,IDBAM2 | |
18247 | C standard particle data interface | |
18248 | INTEGER NMXHEP | |
18249 | PARAMETER (NMXHEP=4000) | |
18250 | INTEGER NEVHEP,NHEP,ISTHEP,IDHEP,JMOHEP,JDAHEP | |
18251 | DOUBLE PRECISION PHEP,VHEP | |
18252 | COMMON /POEVT1/ NEVHEP,NHEP,ISTHEP(NMXHEP),IDHEP(NMXHEP), | |
18253 | & JMOHEP(2,NMXHEP),JDAHEP(2,NMXHEP),PHEP(5,NMXHEP), | |
18254 | & VHEP(4,NMXHEP) | |
18255 | C extension to standard particle data interface (PHOJET specific) | |
18256 | INTEGER IMPART,IPHIST,ICOLOR | |
18257 | COMMON /POEVT2/ IMPART(NMXHEP),IPHIST(2,NMXHEP),ICOLOR(2,NMXHEP) | |
18258 | ||
18259 | DOUBLE PRECISION PTS,PB,XP,XPB,PC | |
18260 | DIMENSION PTS(0:2,50),PB(0:2,2),XP(50),XPB(2),PC(4) | |
18261 | ||
18262 | INTEGER MODIFY,IV,IVB | |
18263 | DIMENSION MODIFY(50),IV(50),IVB(2) | |
18264 | ||
18265 | C debug output | |
18266 | IF(IDEB(6).GE.10) WRITE(LO,'(1X,A,3I4,1P,E11.3)') | |
18267 | & 'PHO_PARTPT: called with IMODE,IF,IL,PTCUT', | |
18268 | & IMODE,IF,IL,PTCUT | |
18269 | ||
18270 | IF(IMODE.LT.0) GOTO 1000 | |
18271 | ||
18272 | IREJ = 0 | |
18273 | IF((ISWMDL(3).EQ.10).AND.(ISWMDL(4).EQ.10)) RETURN | |
18274 | ||
18275 | C count entries to modify | |
18276 | IENTRY = 0 | |
18277 | PTCUT2 = PTCUT**2 | |
18278 | EMIN = 1.D20 | |
18279 | IPEAK = 1 | |
18280 | ISTART = IF | |
18281 | ||
18282 | C soft Pomerons | |
18283 | ||
18284 | IF(IMODE.EQ.0) THEN | |
18285 | DO 300 I=ISTART,IL | |
18286 | IF((ISTHEP(I).EQ.-1).AND.(ABS(IPHIST(1,I)).LT.100)) THEN | |
18287 | IENTRY = IENTRY+1 | |
18288 | MODIFY(IENTRY) = I | |
18289 | XP(IENTRY) = SIGN(PHEP(4,I)/ECMP,PHEP(3,I)) | |
18290 | IV(IENTRY) = 0 | |
18291 | IF(IDHEP(I).NE.21) IV(IENTRY) = ICOLOR(2,I) | |
18292 | IF(PHEP(4,I).LT.EMIN) THEN | |
18293 | EMIN = PHEP(4,I) | |
18294 | IPEAK = IENTRY | |
18295 | ENDIF | |
18296 | ENDIF | |
18297 | 300 CONTINUE | |
18298 | ||
18299 | C hard Pomeron associated remnants (IPHIST(1,)=100,200,...) | |
18300 | ||
18301 | ELSE IF(IMODE.EQ.1) THEN | |
18302 | ||
18303 | DO 350 I=ISTART,IL | |
18304 | IF((ISTHEP(I).EQ.-1).AND.(IPHIST(1,I).GE.100)) THEN | |
18305 | IF(MOD(IPHIST(1,I),100).EQ.0) THEN | |
18306 | IENTRY = IENTRY+1 | |
18307 | MODIFY(IENTRY) = I | |
18308 | XP(IENTRY) = SIGN(PHEP(4,I)/ECMP,PHEP(3,I)) | |
18309 | IF(ISWMDL(24).EQ.0) THEN | |
18310 | IV(IENTRY) = 0 | |
18311 | IF(IDHEP(I).NE.21) IV(IENTRY) = ICOLOR(2,I) | |
18312 | ELSE IF(ISWMDL(24).EQ.1) THEN | |
18313 | IV(IENTRY) = -1 | |
18314 | ELSE | |
18315 | IV(IENTRY) = 1 | |
18316 | ENDIF | |
18317 | IF(PHEP(4,I).LT.EMIN) THEN | |
18318 | EMIN = PHEP(4,I) | |
18319 | IPEAK = IENTRY | |
18320 | ENDIF | |
18321 | ENDIF | |
18322 | ENDIF | |
18323 | 350 CONTINUE | |
18324 | ||
18325 | C something wrong | |
18326 | ||
18327 | ELSE | |
18328 | WRITE(LO,'(/1X,A,I5)') 'PHO_PARTPT:ERROR: invalid mode',IMODE | |
18329 | CALL PHO_ABORT | |
18330 | ENDIF | |
18331 | ||
18332 | C debug output | |
18333 | IF(IDEB(6).GE.5) THEN | |
18334 | WRITE(LO,'(1X,2A,3I4)') 'PHO_PARTPT: ', | |
18335 | & 'number of partons, IPEAK,MODE',IENTRY,IPEAK,IMODE | |
18336 | IF(IDEB(6).GE.20) CALL PHO_PREVNT(0) | |
18337 | ENDIF | |
18338 | ||
18339 | C nothing to do | |
18340 | IF(IENTRY.LE.1) RETURN | |
18341 | ||
18342 | C sample pt of soft partons | |
18343 | ||
18344 | IF(ISWMDL(5).LE.1) THEN | |
18345 | ITER = 0 | |
18346 | IPEAK = DT_RNDM(DUM)*IENTRY+1 | |
18347 | CALL PHO_SWAPI(MODIFY(IPEAK),MODIFY(1)) | |
18348 | CALL PHO_SWAPD(XP(IPEAK),XP(1)) | |
18349 | CALL PHO_SWAPI(IV(IPEAK),IV(1)) | |
18350 | 400 CONTINUE | |
18351 | C energy limited sampling | |
18352 | PSUMX = 0.D0 | |
18353 | PSUMY = 0.D0 | |
18354 | ITER = ITER+1 | |
18355 | IF(ITER.GE.1000) THEN | |
18356 | IF(IDEB(6).GE.3) THEN | |
18357 | WRITE(LO,'(1X,A,3I5)') | |
18358 | & 'PHO_PARTPT: rejection for MODE,ENTRY,ITER', | |
18359 | & IMODE,IENTRY,ITER | |
18360 | WRITE(LO,'(8X,A,I5)') 'I II IV XP EP', | |
18361 | & IPEAK | |
18362 | DO 405 I=1,IENTRY | |
18363 | II = MODIFY(I) | |
18364 | WRITE(LO,'(5X,3I5,1P,2E13.4)') | |
18365 | & I,II,IV(I),XP(I),PHEP(4,II) | |
18366 | 405 CONTINUE | |
18367 | IF(IDEB(6).GE.5) CALL PHO_PREVNT(0) | |
18368 | ENDIF | |
18369 | IREJ = 1 | |
18370 | RETURN | |
18371 | ENDIF | |
18372 | DO 410 I=2,IENTRY | |
18373 | II = MODIFY(I) | |
18374 | PTMX = MIN(PHEP(4,II),PTCUT) | |
18375 | XPB(1) = XP(I) | |
18376 | IVB(1) = IV(I) | |
18377 | IF(ISWMDL(5).EQ.0) THEN | |
18378 | CALL PHO_SOFTPT(1,PTCUT,PTMX,XPB,IVB,PB) | |
18379 | ELSE | |
18380 | CALL PHO_SOFTPT(1,PTMX,PTMX,XPB,IVB,PB) | |
18381 | ENDIF | |
18382 | PTS(0,I) = PB(0,1) | |
18383 | PTS(1,I) = PB(1,1) | |
18384 | PTS(2,I) = PB(2,1) | |
18385 | PSUMX = PSUMX+PB(1,1) | |
18386 | PSUMY = PSUMY+PB(2,1) | |
18387 | 410 CONTINUE | |
18388 | PTREM = SQRT(PSUMX**2+PSUMY**2) | |
18389 | IF(PTREM.GT.MIN(PHEP(4,MODIFY(1)),PTCUT)) GOTO 400 | |
18390 | PTS(1,1) = -PSUMX | |
18391 | PTS(2,1) = -PSUMY | |
18392 | ELSE IF((ISWMDL(5).EQ.2) | |
18393 | & .OR.((IMODE.EQ.1).AND.(ISWMDL(5).EQ.3))) THEN | |
18394 | C unlimited sampling | |
18395 | IPEAK = DT_RNDM(PSUMX)*IENTRY+1 | |
18396 | CALL PHO_SWAPI(MODIFY(IPEAK),MODIFY(1)) | |
18397 | CALL PHO_SWAPD(XP(IPEAK),XP(1)) | |
18398 | CALL PHO_SWAPI(IV(IPEAK),IV(1)) | |
18399 | CALL PHO_SOFTPT(IENTRY,PTCUT,PTCUT,XP,IV,PTS) | |
18400 | ELSE IF(ISWMDL(5).EQ.3) THEN | |
18401 | C each string has balanced pt | |
18402 | DO 500 K=1,IENTRY | |
18403 | IF(IV(K).LE.-90) GOTO 499 | |
18404 | I1 = MODIFY(K) | |
18405 | IC1 = -ICOLOR(1,I1) | |
18406 | DO 510 L=K+1,IENTRY | |
18407 | IF(ICOLOR(1,MODIFY(L)).EQ.IC1) GOTO 511 | |
18408 | 510 CONTINUE | |
18409 | WRITE(LO,'(//1X,A,I5)') | |
18410 | & 'PHO_PARTPT:ERROR: no color found for (line,color)',I1,-IC1 | |
18411 | CALL PHO_ABORT | |
18412 | 511 CONTINUE | |
18413 | I2 = MODIFY(L) | |
18414 | AMSQR = (PHEP(4,I1)+PHEP(4,I2))**2-(PHEP(1,I1)+PHEP(1,I2))**2 | |
18415 | & -(PHEP(2,I1)+PHEP(2,I2))**2-(PHEP(3,I1)+PHEP(3,I2))**2 | |
18416 | AM = SQRT(AMSQR) | |
18417 | PTMX = AM/2.D0 | |
18418 | IVB(1) = MAX(IV(K),IV(L)) | |
18419 | XPB(1) = XP(K) | |
18420 | CALL PHO_SOFTPT(1,PTCUT,PTMX,XPB,IVB,PB) | |
18421 | PTS(1,K) = PB(1,1) | |
18422 | PTS(2,K) = PB(2,1) | |
18423 | PTS(1,L) = -PB(1,1) | |
18424 | PTS(2,L) = -PB(2,1) | |
18425 | GAM = (PHEP(4,I1)+PHEP(4,I2))/AM | |
18426 | GAMBEZ = (PHEP(3,I1)+PHEP(3,I2))/AM | |
18427 | PC(1) = PB(1,1) | |
18428 | PC(2) = PB(2,1) | |
18429 | PLONG = SQRT(PTMX**2-PB(0,1)**2+1.D-12) | |
18430 | PC(3) = SIGN(PLONG,PHEP(3,I1)) | |
18431 | PC(4) = PTMX | |
18432 | CALL PHO_ALTRA(GAM,0.D0,0.D0,GAMBEZ,PC(1),PC(2),PC(3),PC(4), | |
18433 | & PTOT,PHEP(1,I1),PHEP(2,I1),PHEP(3,I1),PHEP(4,I1)) | |
18434 | PC(1) = -PC(1) | |
18435 | PC(2) = -PC(2) | |
18436 | PC(3) = -PC(3) | |
18437 | CALL PHO_ALTRA(GAM,0.D0,0.D0,GAMBEZ,PC(1),PC(2),PC(3),PC(4), | |
18438 | & PTOT,PHEP(1,I2),PHEP(2,I2),PHEP(3,I2),PHEP(4,I2)) | |
18439 | IV(K) = IV(K)-100 | |
18440 | IV(L) = IV(L)-100 | |
18441 | 499 CONTINUE | |
18442 | 500 CONTINUE | |
18443 | ELSE | |
18444 | WRITE(LO,'(/1X,A,I4)') | |
18445 | & 'PHO_PARTPT:ERROR: invalid value of ISWMDL(5):',ISWMDL(5) | |
18446 | CALL PHO_ABORT | |
18447 | ENDIF | |
18448 | ||
18449 | C change partons in /POEVT1/ | |
18450 | DO 900 II=1,IENTRY | |
18451 | IF(IV(II).GT.-90) THEN | |
18452 | I = MODIFY(II) | |
18453 | PHEP(1,I) = PHEP(1,I)+PTS(1,II) | |
18454 | PHEP(2,I) = PHEP(2,I)+PTS(2,II) | |
18455 | AMSQR = PHEP(4,I)**2 | |
18456 | & -PHEP(1,I)**2-PHEP(2,I)**2-PHEP(3,I)**2 | |
18457 | PHEP(5,I) = SIGN(SQRT(ABS(AMSQR)),AMSQR) | |
18458 | ENDIF | |
18459 | 900 CONTINUE | |
18460 | ||
18461 | C debug output | |
18462 | IF(IDEB(6).GE.15) THEN | |
18463 | WRITE(LO,'(1X,A,/,8X,A,I5)') 'PHO_PARTPT: table of momenta', | |
18464 | & 'I II IV XP EP PTS PTX PTY',IPEAK | |
18465 | DO 505 I=1,IENTRY | |
18466 | II = MODIFY(I) | |
18467 | WRITE(LO,'(2X,3I5,1P,5E12.4)') | |
18468 | & I,II,IV(I),XP(I),PHEP(4,II),PTS(0,I),PTS(1,I),PTS(2,I) | |
18469 | 505 CONTINUE | |
18470 | CALL PHO_PREVNT(0) | |
18471 | ENDIF | |
18472 | RETURN | |
18473 | ||
18474 | C initialization / output of statistics | |
18475 | 1000 CONTINUE | |
18476 | CALL PHO_SOFTPT(IMODE,PTM,PTM,XP,IV,PTS) | |
18477 | ||
18478 | END | |
18479 | ||
18480 | *$ CREATE PHO_SOFTPT.FOR | |
18481 | *COPY PHO_SOFTPT | |
18482 | CDECK ID>, PHO_SOFTPT | |
18483 | SUBROUTINE PHO_SOFTPT(ISOFT,PTCUT,PTMAX,XV,IV,PTSOF) | |
18484 | C*********************************************************************** | |
18485 | C | |
18486 | C select pt of soft string ends | |
18487 | C | |
18488 | C input: ISOFT number of soft partons | |
18489 | C -1 initialization | |
18490 | C >=0 sampling of p_t | |
18491 | C -2 output of statistics | |
18492 | C PTCUT cutoff for soft strings | |
18493 | C PTMAX maximal allowed PT | |
18494 | C XV field of x values | |
18495 | C IV 0 sea quark | |
18496 | C 1 valence quark | |
18497 | C | |
18498 | C output: /POINT3/ containing parameters AAS,BETAS | |
18499 | C PTSOF filed with soft pt values | |
18500 | C | |
18501 | C note: ISWMDL(3/4) = 0 dNs/dP_t = P_t ASS * exp(-BETA*P_t**2) | |
18502 | C ISWMDL(3/4) = 1 dNs/dP_t = P_t ASS * exp(-BETA*P_t) | |
18503 | C ISWMDL(3/4) = 2 photon wave function | |
18504 | C ISWMDL(3/4) = 10 no soft P_t assignment | |
18505 | C | |
18506 | C*********************************************************************** | |
18507 | IMPLICIT DOUBLE PRECISION (A-H,O-Z) | |
18508 | SAVE | |
18509 | ||
18510 | PARAMETER ( DEPS = 1.D-15) | |
18511 | ||
18512 | DIMENSION PTSOF(0:2,*),XV(*) | |
18513 | DIMENSION IV(*) | |
18514 | ||
18515 | C input/output channels | |
18516 | INTEGER LI,LO | |
18517 | COMMON /POINOU/ LI,LO | |
18518 | C event debugging information | |
18519 | INTEGER NMAXD | |
18520 | PARAMETER (NMAXD=100) | |
18521 | INTEGER IDEB,KSPOM,KHPOM,KSREG,KHDIR,KACCEP,KSTRG,KHTRG,KSLOO, | |
18522 | & KHLOO,KSDPO,KHDPO,KEVENT,KSOFT,KHARD | |
18523 | COMMON /PODEBG/ IDEB(NMAXD),KSPOM,KHPOM,KSREG,KHDIR,KACCEP,KSTRG, | |
18524 | & KHTRG,KSLOO,KHLOO,KSDPO,KHDPO,KEVENT,KSOFT,KHARD | |
18525 | C model switches and parameters | |
18526 | CHARACTER*8 MDLNA | |
18527 | INTEGER ISWMDL,IPAMDL | |
18528 | DOUBLE PRECISION PARMDL | |
18529 | COMMON /POMDLS/ MDLNA(50),ISWMDL(50),PARMDL(400),IPAMDL(400) | |
18530 | C data of c.m. system of Pomeron / Reggeon exchange | |
18531 | INTEGER NPOSP,IDPDG1,IDBAM1,IDPDG2,IDBAM2 | |
18532 | DOUBLE PRECISION ECMP,PCMP,PMASSP,PVIRTP,GAMBEP, | |
18533 | & SIDP,CODP,SIFP,COFP | |
18534 | COMMON /POPCMS/ ECMP,PCMP,PMASSP(2),PVIRTP(2),GAMBEP(4), | |
18535 | & SIDP,CODP,SIFP,COFP,NPOSP(2), | |
18536 | & IDPDG1,IDBAM1,IDPDG2,IDBAM2 | |
18537 | C data on most recent hard scattering | |
18538 | INTEGER IA,IB,IC,ID,IV1,IV2,MSPR,IREJSC | |
18539 | DOUBLE PRECISION PTWANT,AS,AH,ALNS,ALNH,Z1MAX,Z1DIF,Z2MAX,Z2DIF, | |
18540 | & PT,PTfin,ETAC,ETAD,X1,X2,V,U,W,W1,AXX,QQPD,QQAL, | |
18541 | & PDF1,PDF2,WEIGHT,PHI1,PHI2,PHO1,PHO2 | |
18542 | COMMON /POCKIN/ PTWANT,AS,AH,ALNS,ALNH,Z1MAX,Z1DIF,Z2MAX,Z2DIF, | |
18543 | & PT,PTfin,ETAC,ETAD,X1,X2,V,U,W,W1,AXX, | |
18544 | & QQPD,QQAL,PDF1(-6:6),PDF2(-6:6),WEIGHT, | |
18545 | & PHI1(5),PHI2(5),PHO1(5),PHO2(5), | |
18546 | & IA,IB,IC,ID,IV1,IV2,MSPR,IREJSC | |
18547 | C data needed for soft-pt calculation | |
18548 | DOUBLE PRECISION SIGS,DSIGHP,SIGH,FS,FH,BETAS,AAS,PTCON | |
18549 | COMMON /POINT3/ SIGS,DSIGHP,SIGH,FS,FH,BETAS(3),AAS,PTCON | |
18550 | ||
18551 | DIMENSION BETAB(100) | |
18552 | ||
18553 | C selection of pt | |
18554 | IF(ISOFT.GE.0) THEN | |
18555 | CALLS = CALLS + 1.D0 | |
18556 | C sample according to model ISWMDL(3-6) | |
18557 | IF(ISOFT.GT.1) THEN | |
18558 | 210 CONTINUE | |
18559 | PTXS = 0.D0 | |
18560 | PTYS = 0.D0 | |
18561 | DO 300 I=2,ISOFT | |
18562 | IMODE = ISWMDL(3) | |
18563 | C valence partons | |
18564 | IF(IV(I).EQ.1) THEN | |
18565 | BETA = BETAS(1) | |
18566 | C photon/pomeron valence part | |
18567 | IF(IPAMDL(5).EQ.1) THEN | |
18568 | IF(XV(I).GE.0.D0) THEN | |
18569 | IF((IDPDG1.EQ.22).OR.(IDPDG1.EQ.990)) THEN | |
18570 | IMODE = ISWMDL(4) | |
18571 | BETA = BETAS(3) | |
18572 | ENDIF | |
18573 | ELSE | |
18574 | IF((IDPDG2.EQ.22).OR.(IDPDG2.EQ.990)) THEN | |
18575 | IMODE = ISWMDL(4) | |
18576 | BETA = BETAS(3) | |
18577 | ENDIF | |
18578 | ENDIF | |
18579 | ELSE IF(IPAMDL(5).EQ.2) THEN | |
18580 | BETA = PARMDL(20) | |
18581 | ELSE IF(IPAMDL(5).EQ.3) THEN | |
18582 | BETA = BETAS(3) | |
18583 | ENDIF | |
18584 | C sea partons | |
18585 | ELSE IF(IV(I).EQ.0) THEN | |
18586 | BETA = BETAS(3) | |
18587 | C hard scattering remnant | |
18588 | ELSE | |
18589 | IF(IPAMDL(6).EQ.0) THEN | |
18590 | BETA = BETAS(1) | |
18591 | ELSE IF(IPAMDL(6).EQ.1) THEN | |
18592 | BETA = BETAS(3) | |
18593 | ELSE | |
18594 | BETA = PARMDL(20) | |
18595 | ENDIF | |
18596 | ENDIF | |
18597 | BETA = MAX(BETA,0.01D0) | |
18598 | CALL PHO_SELPT(XV(I),0.D0,PTCUT,PTS,BETA,IMODE) | |
18599 | PTS = MIN(PTMAX,PTS) | |
18600 | CALL PHO_SFECFE(SIG,COG) | |
18601 | PTSOF(0,I) = PTS | |
18602 | PTSOF(1,I) = COG*PTS | |
18603 | PTSOF(2,I) = SIG*PTS | |
18604 | PTXS = PTXS+PTSOF(1,I) | |
18605 | PTYS = PTYS+PTSOF(2,I) | |
18606 | BETAB(I) = BETA | |
18607 | 300 CONTINUE | |
18608 | C balancing of momenta | |
18609 | PTS = SQRT(PTXS**2+PTYS**2) | |
18610 | IF(PTS.GE.PTMAX) GOTO 210 | |
18611 | PTSOF(0,1) = PTS | |
18612 | PTSOF(1,1) = -PTXS | |
18613 | PTSOF(2,1) = -PTYS | |
18614 | BETAB(1) = 0.D0 | |
18615 | C | |
18616 | *400 CONTINUE | |
18617 | C | |
18618 | C single parton only | |
18619 | ELSE | |
18620 | IMODE = ISWMDL(3) | |
18621 | C valence partons | |
18622 | IF(IV(1).EQ.1) THEN | |
18623 | BETA = BETAS(1) | |
18624 | C photon/Pomeron valence part | |
18625 | IF(IPAMDL(5).EQ.1) THEN | |
18626 | IF(XV(1).GE.0.D0) THEN | |
18627 | IF((IDPDG1.EQ.22).OR.(IDPDG1.EQ.990)) THEN | |
18628 | IMODE = ISWMDL(4) | |
18629 | BETA = BETAS(3) | |
18630 | ENDIF | |
18631 | ELSE | |
18632 | IF((IDPDG2.EQ.22).OR.(IDPDG2.EQ.990)) THEN | |
18633 | IMODE = ISWMDL(4) | |
18634 | BETA = BETAS(3) | |
18635 | ENDIF | |
18636 | ENDIF | |
18637 | ELSE IF(IPAMDL(5).EQ.2) THEN | |
18638 | BETA = PARMDL(20) | |
18639 | ELSE IF(IPAMDL(5).EQ.3) THEN | |
18640 | BETA = BETAS(3) | |
18641 | ENDIF | |
18642 | C sea partons | |
18643 | ELSE IF(IV(1).EQ.0) THEN | |
18644 | BETA = BETAS(3) | |
18645 | C hard scattering remnant | |
18646 | ELSE | |
18647 | IF(IPAMDL(6).EQ.1) THEN | |
18648 | BETA = BETAS(3) | |
18649 | ELSE | |
18650 | BETA = PARMDL(20) | |
18651 | ENDIF | |
18652 | ENDIF | |
18653 | BETA = MAX(BETA,0.01D0) | |
18654 | CALL PHO_SELPT(XV(1),0.D0,PTCUT,PTS,BETA,IMODE) | |
18655 | PTS = MIN(PTMAX,PTS) | |
18656 | CALL PHO_SFECFE(SIG,COG) | |
18657 | PTSOF(0,1) = PTS | |
18658 | PTSOF(1,1) = COG*PTS | |
18659 | PTSOF(2,1) = SIG*PTS | |
18660 | BETAB(1) = BETA | |
18661 | ENDIF | |
18662 | C debug output | |
18663 | IF(IDEB(29).GE.10) THEN | |
18664 | WRITE(LO,'(1X,A,I4)') 'PHO_SOFTPT: ISOFT',ISOFT | |
18665 | WRITE(LO,'(6X,A)') 'TABLE OF I, IV, XV, PT, PT-X, PT-Y, BETA' | |
18666 | DO 105 I=1,ISOFT | |
18667 | WRITE(LO,'(10X,2I3,1P,5E12.3)') I,IV(I),XV(I),PTSOF(0,I), | |
18668 | & PTSOF(1,I),PTSOF(2,I),BETAB(I) | |
18669 | 105 CONTINUE | |
18670 | ENDIF | |
18671 | ||
18672 | C initialization of statistics and parameters | |
18673 | ||
18674 | ELSE IF(ISOFT.EQ.-1) THEN | |
18675 | PTSMIN = 0.D0 | |
18676 | PTSMAX = PTCUT | |
18677 | IMODE = -100+ISWMDL(3) | |
18678 | CALL PHO_SELPT(ECMP,PTSMIN,PTSMAX,PTS,BETAS(3),IMODE) | |
18679 | ||
18680 | C output of statistics | |
18681 | ||
18682 | ELSE IF(ISOFT.EQ.-2) THEN | |
18683 | ELSE | |
18684 | WRITE(LO,'(1X,2A,I2)') 'PHO_SOFTPT:ERROR: ', | |
18685 | & 'unsupported ISOFT ',ISOFT | |
18686 | STOP | |
18687 | ENDIF | |
18688 | END | |
18689 | ||
18690 | *$ CREATE PHO_SELPT.FOR | |
18691 | *COPY PHO_SELPT | |
18692 | CDECK ID>, PHO_SELPT | |
18693 | SUBROUTINE PHO_SELPT(EE,PTLOW,PTHIGH,PTS,BETA,IMODE) | |
18694 | C*********************************************************************** | |
18695 | C | |
18696 | C select pt from different distributions | |
18697 | C | |
18698 | C input: EE energy (for initialization only) | |
18699 | C otherwise x value of corresponding parton | |
18700 | C PTLOW lower pt limit | |
18701 | C PTHIGH upper pt limit | |
18702 | C (PTHIGH > 20 will cause DEXP underflows) | |
18703 | C | |
18704 | C IMODE = 0 dNs/dP_t = P_t * ASS * exp(-BETA*P_t**2) | |
18705 | C IMODE = 1 dNs/dP_t = P_t * ASS * exp(-BETA*P_t) | |
18706 | C IMODE = 2 dNs/dP_t according photon wave function | |
18707 | C IMODE = 10 no sampling | |
18708 | C | |
18709 | C IMODE = -100+IMODE initialization according to | |
18710 | C given limitations | |
18711 | C | |
18712 | C output: PTS sampled pt value | |
18713 | C initialization: | |
18714 | C BETA soft pt slope in central region | |
18715 | C | |
18716 | C*********************************************************************** | |
18717 | IMPLICIT DOUBLE PRECISION (A-H,O-Z) | |
18718 | SAVE | |
18719 | ||
18720 | PARAMETER ( PI2 = 6.28318530718D0, | |
18721 | & AMIN = 1.D-2, | |
18722 | & EPS = 1.D-7, | |
18723 | & DEPS = 1.D-30) | |
18724 | ||
18725 | C input/output channels | |
18726 | INTEGER LI,LO | |
18727 | COMMON /POINOU/ LI,LO | |
18728 | C event debugging information | |
18729 | INTEGER NMAXD | |
18730 | PARAMETER (NMAXD=100) | |
18731 | INTEGER IDEB,KSPOM,KHPOM,KSREG,KHDIR,KACCEP,KSTRG,KHTRG,KSLOO, | |
18732 | & KHLOO,KSDPO,KHDPO,KEVENT,KSOFT,KHARD | |
18733 | COMMON /PODEBG/ IDEB(NMAXD),KSPOM,KHPOM,KSREG,KHDIR,KACCEP,KSTRG, | |
18734 | & KHTRG,KSLOO,KHLOO,KSDPO,KHDPO,KEVENT,KSOFT,KHARD | |
18735 | C model switches and parameters | |
18736 | CHARACTER*8 MDLNA | |
18737 | INTEGER ISWMDL,IPAMDL | |
18738 | DOUBLE PRECISION PARMDL | |
18739 | COMMON /POMDLS/ MDLNA(50),ISWMDL(50),PARMDL(400),IPAMDL(400) | |
18740 | C data of c.m. system of Pomeron / Reggeon exchange | |
18741 | INTEGER NPOSP,IDPDG1,IDBAM1,IDPDG2,IDBAM2 | |
18742 | DOUBLE PRECISION ECMP,PCMP,PMASSP,PVIRTP,GAMBEP, | |
18743 | & SIDP,CODP,SIFP,COFP | |
18744 | COMMON /POPCMS/ ECMP,PCMP,PMASSP(2),PVIRTP(2),GAMBEP(4), | |
18745 | & SIDP,CODP,SIFP,COFP,NPOSP(2), | |
18746 | & IDPDG1,IDBAM1,IDPDG2,IDBAM2 | |
18747 | C average number of cut soft and hard ladders (obsolete) | |
18748 | DOUBLE PRECISION AVERI,AVERK,AVERL,AVERM,AVERN | |
18749 | COMMON /POINT2/ AVERI,AVERK,AVERL,AVERM,AVERN | |
18750 | C data needed for soft-pt calculation | |
18751 | DOUBLE PRECISION SIGS,DSIGHP,SIGH,FS,FH,BETAS,AAS,PTCON | |
18752 | COMMON /POINT3/ SIGS,DSIGHP,SIGH,FS,FH,BETAS(3),AAS,PTCON | |
18753 | ||
18754 | DOUBLE PRECISION PHO_CONN0,PHO_CONN1 | |
18755 | EXTERNAL PHO_CONN0,PHO_CONN1 | |
18756 | ||
18757 | C initialization | |
18758 | ||
18759 | IF(IMODE.LT.0) GOTO 100 | |
18760 | ||
18761 | PX = PTHIGH | |
18762 | PTS = 0.D0 | |
18763 | ||
18764 | C initial checks | |
18765 | ||
18766 | IF(PX.LT.AMIN) RETURN | |
18767 | ||
18768 | IF((PX-PTLOW).LT.0.01) THEN | |
18769 | IF(IDEB(5).GE.3) WRITE(LO,'(1X,A,2E12.3,I3)') | |
18770 | & 'PHO_SELPT: PTLOW,PTHIGH,IMODE ',PTLOW,PTHIGH,IMODE | |
18771 | RETURN | |
18772 | ENDIF | |
18773 | ||
18774 | C sampling of pt values according to IMODE | |
18775 | ||
18776 | IF(IMODE.EQ.0) THEN | |
18777 | ||
18778 | FAC1 = EXP(-BETA*PX**2) | |
18779 | FAC2 = (1.D0-FAC1) | |
18780 | 25 CONTINUE | |
18781 | XI1 = DT_RNDM(PX)*FAC2 + FAC1 | |
18782 | PTS = SQRT(-1.D0/BETA*LOG(XI1)) | |
18783 | IF((PTS.GT.PTHIGH).OR.(PTS.LT.PTLOW)) GOTO 25 | |
18784 | ||
18785 | ELSE IF(IMODE.EQ.1) THEN | |
18786 | ||
18787 | XIMIN = EXP(-BETA*PTHIGH) | |
18788 | XIDEL = 1.D0-XIMIN | |
18789 | 50 CONTINUE | |
18790 | PTS = -LOG((XIDEL*DT_RNDM(XIDEL)+XIMIN) | |
18791 | & *(XIDEL*DT_RNDM(XIMIN)+XIMIN)+DEPS)/BETA | |
18792 | IF(PTS.LT.XMT) GOTO 50 | |
18793 | PTS = SQRT(PTS**2-XMT2) | |
18794 | IF((PTS.GT.PTHIGH).OR.(PTS.LT.PTLOW)) GOTO 50 | |
18795 | ||
18796 | ELSE IF(IMODE.EQ.2) THEN | |
18797 | ||
18798 | IF(EE.GE.0.D0) THEN | |
18799 | P2 = PVIRTP(1) | |
18800 | ELSE | |
18801 | P2 = PVIRTP(2) | |
18802 | ENDIF | |
18803 | XV = ABS(EE) | |
18804 | AA = (1.D0-XV)*XV*P2+PARMDL(25) | |
18805 | 75 CONTINUE | |
18806 | PTS = SQRT(AA/(DT_RNDM(PX)+EPS)-AA) | |
18807 | IF((PTS.GT.PTHIGH).OR.(PTS.LT.PTLOW)) GOTO 75 | |
18808 | ||
18809 | C something wrong | |
18810 | ||
18811 | ELSE IF(IMODE.NE.10) THEN | |
18812 | WRITE(LO,'(/1X,A,I4)') 'PHO_SELPT:ERROR: invalid IMODE',IMODE | |
18813 | CALL PHO_ABORT | |
18814 | ENDIF | |
18815 | ||
18816 | C debug output | |
18817 | IF(IDEB(5).GE.20) THEN | |
18818 | WRITE(LO,'(1X,A,I3,4E10.3)') | |
18819 | & 'PHO_SELPT: MODE,BET,PTMI,PTMA,PT', | |
18820 | & IMODE,BETA,PTLOW,PTHIGH,PTS | |
18821 | ENDIF | |
18822 | RETURN | |
18823 | ||
18824 | C initialization | |
18825 | 100 CONTINUE | |
18826 | PTSMIN = PTLOW | |
18827 | PTSMAX = PTHIGH | |
18828 | PTCON = PTHIGH | |
18829 | C calculation of parameters | |
18830 | INIT = IMODE+100 | |
18831 | AAS = 0.D0 | |
18832 | ||
18833 | C initialization for model 0 (gaussian pt distribution) | |
18834 | ||
18835 | IF(INIT.EQ.0) THEN | |
18836 | BETAS(1) = PARMDL(23)+0.15D0*LOG(EE)*(PARMDL(24)-PARMDL(23)) | |
18837 | BETUP = BETAS(1) | |
18838 | BETLO = -2.D0 | |
18839 | XTOL = PHO_CONN0(BETLO)*PHO_CONN0(BETUP) | |
18840 | IF(XTOL.LT.0.D0) THEN | |
18841 | XTOL = 1.D-4 | |
18842 | METHOD = 1 | |
18843 | MAXF = 500 | |
18844 | BETA = 0.D0 | |
18845 | BETA = PHO_DZEROX(BETLO,BETUP,XTOL,MAXF,PHO_CONN0,METHOD) | |
18846 | * IF(BETA.LT.-1.D+10) THEN | |
18847 | * WRITE(LO,'(1X,2A,1P,2E11.3)') 'PHO_SELPT: no Beta found ', | |
18848 | * & '(model 0: Ecm,PTcut)',EE,PTCON | |
18849 | * WRITE(LO,'(1X,A,1P,3E10.3)') | |
18850 | * & 'PHO_SELPT: SIGS,SIGH,DSIGHP',SIGS,SIGH,DSIGHP | |
18851 | * CALL PHO_PREVNT(-1) | |
18852 | * BETA = 0.01 | |
18853 | * ELSE | |
18854 | AAS = DSIGHP/PTCON*EXP(-BETA*PTCON**2) | |
18855 | * ENDIF | |
18856 | ELSE | |
18857 | AAS = 0.D0 | |
18858 | BETA = BETAS(1) | |
18859 | ENDIF | |
18860 | ||
18861 | C initialization for model 1 (exponential pt distribution) | |
18862 | ||
18863 | ELSE IF(INIT.EQ.1) THEN | |
18864 | XMT = PARMDL(43) | |
18865 | XMT2 = XMT*XMT | |
18866 | BETAS(1) = PARMDL(21)+0.15D0*LOG(EE)*(PARMDL(22)-PARMDL(21)) | |
18867 | BETUP = BETAS(1) | |
18868 | BETLO = -3.D0 | |
18869 | XTOL = PHO_CONN1(BETLO)*PHO_CONN1(BETUP) | |
18870 | IF(XTOL.LT.0.D0) THEN | |
18871 | XTOL = 1.D-4 | |
18872 | METHOD = 1 | |
18873 | MAXF = 500 | |
18874 | BETA = 0.D0 | |
18875 | BETA = PHO_DZEROX(BETLO,BETUP,XTOL,MAXF,PHO_CONN1,METHOD) | |
18876 | * IF(BETA.LT.-1.D+10) THEN | |
18877 | * WRITE(LO,'(1X,2A,1P,2E11.3)') 'PHO_SELPT: no Beta found ', | |
18878 | * & '(model 1: Ecm,PTcut)',EE,PTCON | |
18879 | * WRITE(LO,'(1X,A,1P,3E10.3)') | |
18880 | * & 'PHO_SELPT: SIGS,SIGH,DSIGHP',SIGS,SIGH,DSIGHP | |
18881 | * CALL PHO_PREVNT(-1) | |
18882 | * BETA = 0.01 | |
18883 | * ELSE | |
18884 | AAS = DSIGHP/PTCON*EXP(-BETA*PTCON) | |
18885 | * ENDIF | |
18886 | ELSE | |
18887 | AAS = 0.D0 | |
18888 | BETA = BETAS(1) | |
18889 | ENDIF | |
18890 | ELSE IF(INIT.EQ.10) THEN | |
18891 | IF(IDEB(5).GT.10) | |
18892 | & WRITE(LO,'(/1X,A)') 'PHO_SELPT: no soft pt sampling' | |
18893 | RETURN | |
18894 | ELSE | |
18895 | WRITE(LO,'(1X,A,I4)') 'PHO_SELPT:ERROR: invalid distribution', | |
18896 | & INIT | |
18897 | CALL PHO_ABORT | |
18898 | ENDIF | |
18899 | BETA = MIN(BETA,BETAS(1)) | |
18900 | ||
18901 | C hard cross section is too big: neg. beta parameter | |
18902 | IF(BETA.LE.0.D0) THEN | |
18903 | WRITE(LO,'(1X,A,1P,2E12.3)') | |
18904 | & 'PHO_SELPT: parameter BETA negative (BETA,AAS)',BETA,AAS | |
18905 | WRITE(LO,'(1X,A,1P,4E11.3)') 'SIGS,DSIGHP,SIGH,PTCON:', | |
18906 | & SIGS,DSIGHP,SIGH,PTCON | |
18907 | CALL PHO_PREVNT(-1) | |
18908 | ENDIF | |
18909 | ||
18910 | C output of initialization parameters | |
18911 | IF(IDEB(5).GE.10) THEN | |
18912 | WRITE(LO,'(1X,A,I3)') 'PHO_SELPT: initialization for model', | |
18913 | & INIT | |
18914 | WRITE(LO,'(5X,A,1P,2E13.3)') | |
18915 | & 'BETA,AAS ',BETA,AAS | |
18916 | WRITE(LO,'(5X,A,1P,3E13.3)') | |
18917 | & 'ECM,PTMIN,PTMAX ',EE,PTSMIN,PTSMAX | |
18918 | WRITE(LO,'(5X,A,1P,3E13.3)') | |
18919 | & 'SIGS,DSIGHP,SIGH',SIGS,DSIGHP,SIGH | |
18920 | ENDIF | |
18921 | ||
18922 | END | |
18923 | ||
18924 | *$ CREATE PHO_CONN0.FOR | |
18925 | *COPY PHO_CONN0 | |
18926 | CDECK ID>, PHO_CONN0 | |
18927 | DOUBLE PRECISION FUNCTION PHO_CONN0(BETA) | |
18928 | C*********************************************************************** | |
18929 | C | |
18930 | C auxiliary function to determine parameters of soft | |
18931 | C pt distribution dNs/dP_t = P_t * AAS * EXP(-BETA*P_t**2) | |
18932 | C | |
18933 | C internal factors: FS number of soft partons in soft Pomeron | |
18934 | C FH number of soft partons in hard Pomeron | |
18935 | C | |
18936 | C*********************************************************************** | |
18937 | IMPLICIT NONE | |
18938 | SAVE | |
18939 | ||
18940 | C input/output channels | |
18941 | INTEGER LI,LO | |
18942 | COMMON /POINOU/ LI,LO | |
18943 | C average number of cut soft and hard ladders (obsolete) | |
18944 | DOUBLE PRECISION AVERI,AVERK,AVERL,AVERM,AVERN | |
18945 | COMMON /POINT2/ AVERI,AVERK,AVERL,AVERM,AVERN | |
18946 | C data needed for soft-pt calculation | |
18947 | DOUBLE PRECISION SIGS,DSIGHP,SIGH,FS,FH,BETAS,AAS,PTCON | |
18948 | COMMON /POINT3/ SIGS,DSIGHP,SIGH,FS,FH,BETAS(3),AAS,PTCON | |
18949 | ||
18950 | DOUBLE PRECISION BETA,XX,FF | |
18951 | ||
18952 | XX = BETA*PTCON**2 | |
18953 | IF(ABS(XX).LT.1.D-3) THEN | |
18954 | FF = FS*SIGS+FH*SIGH | |
18955 | & - DSIGHP*(PTCON/2.D0+PTCON**3*BETA/4.D0) | |
18956 | ELSE | |
18957 | FF = FS*SIGS+FH*SIGH | |
18958 | & - DSIGHP/(2.D0*PTCON*BETA)*(EXP(XX)-1.D0) | |
18959 | ENDIF | |
18960 | PHO_CONN0 = FF | |
18961 | ||
18962 | * WRITE(LO,'(1X,A,3E12.3)') 'PHO_CONN0:BETA,AAS,FF',BETA,AAS,FF | |
18963 | * WRITE(LO,'(1X,A,3E12.3)') 'PHO_CONN0:SIGS,SIGH,DSIGH',SIGS,SIGH,DSIGHP | |
18964 | ||
18965 | END | |
18966 | ||
18967 | *$ CREATE PHO_CONN1.FOR | |
18968 | *COPY PHO_CONN1 | |
18969 | CDECK ID>, PHO_CONN1 | |
18970 | DOUBLE PRECISION FUNCTION PHO_CONN1(BETA) | |
18971 | C*********************************************************************** | |
18972 | C | |
18973 | C auxiliary function to determine parameters of soft | |
18974 | C pt distribution dNs/dP_t = P_t * AAS * EXP(-BETA*P_t) | |
18975 | C | |
18976 | C internal factors: FS number of soft partons in soft Pomeron | |
18977 | C FH number of soft partons in hard Pomeron | |
18978 | C | |
18979 | C*********************************************************************** | |
18980 | IMPLICIT NONE | |
18981 | SAVE | |
18982 | ||
18983 | C input/output channels | |
18984 | INTEGER LI,LO | |
18985 | COMMON /POINOU/ LI,LO | |
18986 | C average number of cut soft and hard ladders (obsolete) | |
18987 | DOUBLE PRECISION AVERI,AVERK,AVERL,AVERM,AVERN | |
18988 | COMMON /POINT2/ AVERI,AVERK,AVERL,AVERM,AVERN | |
18989 | C data needed for soft-pt calculation | |
18990 | DOUBLE PRECISION SIGS,DSIGHP,SIGH,FS,FH,BETAS,AAS,PTCON | |
18991 | COMMON /POINT3/ SIGS,DSIGHP,SIGH,FS,FH,BETAS(3),AAS,PTCON | |
18992 | ||
18993 | DOUBLE PRECISION BETA,XX,FF | |
18994 | ||
18995 | XX = BETA*PTCON | |
18996 | IF(ABS(XX).LT.1.D-3) THEN | |
18997 | FF = FS*SIGS+FH*SIGH | |
18998 | & - DSIGHP*(PTCON/2.D0+PTCON**2*BETA/6.D0) | |
18999 | ELSE | |
19000 | FF = FS*SIGS+FH*SIGH | |
19001 | & - DSIGHP/(PTCON*BETA**2)*(EXP(XX)-1.D0-BETA*PTCON) | |
19002 | ENDIF | |
19003 | PHO_CONN1 = FF | |
19004 | ||
19005 | * WRITE(LO,'(1X,A,3E12.3)') 'PHO_CONN1:BETA,AAS,FF',BETA,AAS,FF | |
19006 | * WRITE(LO,'(1X,A,3E12.3)') 'PHO_CONN1:SIGS,SIGH,DSIGH',SIGS,SIGH,DSIGHP | |
19007 | ||
19008 | END | |
19009 | ||
19010 | *$ CREATE PHO_MSHELL.FOR | |
19011 | *COPY PHO_MSHELL | |
19012 | CDECK ID>, PHO_MSHELL | |
19013 | SUBROUTINE PHO_MSHELL(PA1,PA2,XM1,XM2,P1,P2,IREJ) | |
19014 | C******************************************************************** | |
19015 | C | |
19016 | C rescaling of momenta of two partons to put both | |
19017 | C on mass shell | |
19018 | C | |
19019 | C input: PA1,PA2 input momentum vectors | |
19020 | C XM1,2 desired masses of particles afterwards | |
19021 | C P1,P2 changed momentum vectors | |
19022 | C | |
19023 | C******************************************************************** | |
19024 | IMPLICIT DOUBLE PRECISION (A-H,O-Z) | |
19025 | SAVE | |
19026 | ||
19027 | PARAMETER ( DEPS = 1.D-20 ) | |
19028 | ||
19029 | DIMENSION PA1(*),PA2(*),P1(*),P2(*) | |
19030 | ||
19031 | C input/output channels | |
19032 | INTEGER LI,LO | |
19033 | COMMON /POINOU/ LI,LO | |
19034 | C event debugging information | |
19035 | INTEGER NMAXD | |
19036 | PARAMETER (NMAXD=100) | |
19037 | INTEGER IDEB,KSPOM,KHPOM,KSREG,KHDIR,KACCEP,KSTRG,KHTRG,KSLOO, | |
19038 | & KHLOO,KSDPO,KHDPO,KEVENT,KSOFT,KHARD | |
19039 | COMMON /PODEBG/ IDEB(NMAXD),KSPOM,KHPOM,KSREG,KHDIR,KACCEP,KSTRG, | |
19040 | & KHTRG,KSLOO,KHLOO,KSDPO,KHDPO,KEVENT,KSOFT,KHARD | |
19041 | C internal rejection counters | |
19042 | INTEGER NMXJ | |
19043 | PARAMETER (NMXJ=60) | |
19044 | CHARACTER*10 REJTIT | |
19045 | INTEGER IFAIL | |
19046 | COMMON /POLOOP/ IFAIL(NMXJ),REJTIT(NMXJ) | |
19047 | ||
19048 | IREJ = 0 | |
19049 | IDEV = 0 | |
19050 | C debug output | |
19051 | IF(IDEB(40).GE.10) THEN | |
19052 | WRITE(LO,'(1X,A)') 'PHO_MSHELL: input momenta:' | |
19053 | WRITE(LO,'(5X,4E12.5)') (PA1(K),K=1,4) | |
19054 | WRITE(LO,'(5X,4E12.5)') (PA2(K),K=1,4) | |
19055 | WRITE(LO,'(5X,A,2E12.3)') 'new masses:',XM1,XM2 | |
19056 | ENDIF | |
19057 | ||
19058 | C Lorentz transformation into system CMS | |
19059 | PX = PA1(1)+PA2(1) | |
19060 | PY = PA1(2)+PA2(2) | |
19061 | PZ = PA1(3)+PA2(3) | |
19062 | EE = PA1(4)+PA2(4) | |
19063 | XMS = EE**2-PX**2-PY**2-PZ**2 | |
19064 | IF(XMS.LT.(XM1+XM2)**2) THEN | |
19065 | IREJ = 1 | |
19066 | IFAIL(37) = IFAIL(37)+1 | |
19067 | ||
19068 | if((xm1.gt.1.D4).or.(xm2.gt.1.D4)) irej = irej/idev | |
19069 | ||
19070 | IF(IDEB(40).GE.3) THEN | |
19071 | WRITE(LO,'(/1X,A,I12)') | |
19072 | & 'PHO_MSHELL:reject: too small string mass (KEVENT)',KEVENT | |
19073 | WRITE(LO,'(5X,A,3E12.4)') 'two-part.mass, part.masses:', | |
19074 | & SIGN(SQRT(ABS(XMS)),XMS),XM1,XM2 | |
19075 | WRITE(LO,'(5X,A,4E11.4)') 'PX,PY,PZ,EE:',PX,PY,PZ,EE | |
19076 | IDEV = 5 | |
19077 | IF(IDEB(40).GE.3) GOTO 55 | |
19078 | ENDIF | |
19079 | RETURN | |
19080 | ENDIF | |
19081 | XMS = SQRT(XMS) | |
19082 | BGX = PX/XMS | |
19083 | BGY = PY/XMS | |
19084 | BGZ = PZ/XMS | |
19085 | GAM = EE/XMS | |
19086 | CALL PHO_ALTRA(GAM,-BGX,-BGY,-BGZ,PA1(1),PA1(2),PA1(3), | |
19087 | & PA1(4),PTOT1,P1(1),P1(2),P1(3),P1(4)) | |
19088 | C rotation angles | |
19089 | PTOT1 = MAX(DEPS,PTOT1) | |
19090 | COD = P1(3)/PTOT1 | |
19091 | SID = SQRT(P1(1)**2+P1(2)**2)/PTOT1 | |
19092 | COF = 1.D0 | |
19093 | SIF = 0.D0 | |
19094 | IF(PTOT1*SID.GT.1.D-5) THEN | |
19095 | COF = P1(1)/(SID*PTOT1) | |
19096 | SIF = P1(2)/(SID*PTOT1) | |
19097 | ANORF = SQRT(COF*COF+SIF*SIF) | |
19098 | COF = COF/ANORF | |
19099 | SIF = SIF/ANORF | |
19100 | ENDIF | |
19101 | ||
19102 | C new CM momentum and energies (for masses XM1,XM2) | |
19103 | XM12 = XM1**2 | |
19104 | XM22 = XM2**2 | |
19105 | SS = XMS**2 | |
19106 | PCMP = PHO_XLAM(SS,XM12,XM22)/(2.D0*XMS) | |
19107 | EE1 = SQRT(XM12+PCMP**2) | |
19108 | EE2 = XMS-EE1 | |
19109 | C back rotation | |
19110 | CALL PHO_TRANS(0.D0,0.D0,PCMP,COD,SID,COF,SIF,XX,YY,ZZ) | |
19111 | CALL PHO_ALTRA(GAM,BGX,BGY,BGZ,XX,YY,ZZ,EE1, | |
19112 | & PTOT1,P1(1),P1(2),P1(3),P1(4)) | |
19113 | CALL PHO_ALTRA(GAM,BGX,BGY,BGZ,-XX,-YY,-ZZ,EE2, | |
19114 | & PTOT2,P2(1),P2(2),P2(3),P2(4)) | |
19115 | ||
19116 | C check consistency | |
19117 | DEL = XMS*0.0001 | |
19118 | IF(ABS(PX-P1(1)-P2(1)).GT.DEL) THEN | |
19119 | IDEV = 1 | |
19120 | ELSE IF(ABS(PY-P1(2)-P2(2)).GT.DEL) THEN | |
19121 | IDEV = 2 | |
19122 | ELSE IF(ABS(PZ-P1(3)-P2(3)).GT.DEL) THEN | |
19123 | IDEV = 3 | |
19124 | ELSE IF(ABS(EE-P1(4)-P2(4)).GT.DEL) THEN | |
19125 | IDEV = 4 | |
19126 | ENDIF | |
19127 | 55 CONTINUE | |
19128 | C debug output | |
19129 | IF(IDEV.NE.0) THEN | |
19130 | WRITE(LO,'(1X,A,I3)') | |
19131 | & 'PHO_MSHELL: inconsistent transformation (IDEV)',IDEV | |
19132 | WRITE(LO,'(1X,A)') 'PHO_MSHELL: input momenta:' | |
19133 | WRITE(LO,'(5X,4E12.5)') (PA1(K),K=1,4) | |
19134 | WRITE(LO,'(5X,4E12.5)') (PA2(K),K=1,4) | |
19135 | WRITE(LO,'(5X,A,3E12.3)') 'ava.mass,masses:',XMS,XM1,XM2 | |
19136 | WRITE(LO,'(1X,A)') 'PHO_MSHELL: output momenta:' | |
19137 | WRITE(LO,'(5X,4E12.5)') (P1(K),K=1,4) | |
19138 | WRITE(LO,'(5X,4E12.5)') (P2(K),K=1,4) | |
19139 | ELSE IF(IDEB(40).GE.10) THEN | |
19140 | WRITE(LO,'(1X,A)') 'PHO_MSHELL: output momenta:' | |
19141 | WRITE(LO,'(5X,4E12.5)') (P1(K),K=1,4) | |
19142 | WRITE(LO,'(5X,4E12.5)') (P2(K),K=1,4) | |
19143 | ENDIF | |
19144 | END | |
19145 | ||
19146 | *$ CREATE PHO_GLU2QU.FOR | |
19147 | *COPY PHO_GLU2QU | |
19148 | CDECK ID>, PHO_GLU2QU | |
19149 | SUBROUTINE PHO_GLU2QU(IG,IQ1,IQ2,IREJ) | |
19150 | C******************************************************************** | |
19151 | C | |
19152 | C split gluon with index I in POEVT1 | |
19153 | C (massless gluon assumed) | |
19154 | C | |
19155 | C input: /POEVT1/ | |
19156 | C IG gluon index | |
19157 | C IQ1 first quark index | |
19158 | C IQ2 second quark index | |
19159 | C | |
19160 | C output: new quarks in /POEVT1/ | |
19161 | C IREJ 1 splitting impossible | |
19162 | C 0 splitting successful | |
19163 | C | |
19164 | C******************************************************************** | |
19165 | IMPLICIT DOUBLE PRECISION (A-H,O-Z) | |
19166 | SAVE | |
19167 | ||
19168 | PARAMETER ( DEPS = 1.D-15, | |
19169 | & EPS = 1.D-5 ) | |
19170 | ||
19171 | C input/output channels | |
19172 | INTEGER LI,LO | |
19173 | COMMON /POINOU/ LI,LO | |
19174 | C event debugging information | |
19175 | INTEGER NMAXD | |
19176 | PARAMETER (NMAXD=100) | |
19177 | INTEGER IDEB,KSPOM,KHPOM,KSREG,KHDIR,KACCEP,KSTRG,KHTRG,KSLOO, | |
19178 | & KHLOO,KSDPO,KHDPO,KEVENT,KSOFT,KHARD | |
19179 | COMMON /PODEBG/ IDEB(NMAXD),KSPOM,KHPOM,KSREG,KHDIR,KACCEP,KSTRG, | |
19180 | & KHTRG,KSLOO,KHLOO,KSDPO,KHDPO,KEVENT,KSOFT,KHARD | |
19181 | C model switches and parameters | |
19182 | CHARACTER*8 MDLNA | |
19183 | INTEGER ISWMDL,IPAMDL | |
19184 | DOUBLE PRECISION PARMDL | |
19185 | COMMON /POMDLS/ MDLNA(50),ISWMDL(50),PARMDL(400),IPAMDL(400) | |
19186 | C standard particle data interface | |
19187 | INTEGER NMXHEP | |
19188 | PARAMETER (NMXHEP=4000) | |
19189 | INTEGER NEVHEP,NHEP,ISTHEP,IDHEP,JMOHEP,JDAHEP | |
19190 | DOUBLE PRECISION PHEP,VHEP | |
19191 | COMMON /POEVT1/ NEVHEP,NHEP,ISTHEP(NMXHEP),IDHEP(NMXHEP), | |
19192 | & JMOHEP(2,NMXHEP),JDAHEP(2,NMXHEP),PHEP(5,NMXHEP), | |
19193 | & VHEP(4,NMXHEP) | |
19194 | C extension to standard particle data interface (PHOJET specific) | |
19195 | INTEGER IMPART,IPHIST,ICOLOR | |
19196 | COMMON /POEVT2/ IMPART(NMXHEP),IPHIST(2,NMXHEP),ICOLOR(2,NMXHEP) | |
19197 | C internal rejection counters | |
19198 | INTEGER NMXJ | |
19199 | PARAMETER (NMXJ=60) | |
19200 | CHARACTER*10 REJTIT | |
19201 | INTEGER IFAIL | |
19202 | COMMON /POLOOP/ IFAIL(NMXJ),REJTIT(NMXJ) | |
19203 | ||
19204 | DIMENSION P1(4),P2(4) | |
19205 | DATA CUTM /0.02D0/ | |
19206 | ||
19207 | IREJ = 0 | |
19208 | ||
19209 | C calculate string masses max possible | |
19210 | IF(ISWMDL(9).EQ.1) THEN | |
19211 | CMASS1=2.D0*(PHEP(4,IG)*PHEP(4,IQ1)-PHEP(1,IG)*PHEP(1,IQ1) | |
19212 | & -PHEP(2,IG)*PHEP(2,IQ1)-PHEP(3,IG)*PHEP(3,IQ1)) | |
19213 | IF(CMASS1.LT.CUTM) THEN | |
19214 | IF(IDEB(73).GE.5) THEN | |
19215 | WRITE(LO,'(1X,A,3I4,4E10.3)') | |
19216 | & 'PHO_GLU2QU:REJECTION:IG,IQ1,IQ2,CMASS1',IG,IQ1,IQ2,CMASS1 | |
19217 | ENDIF | |
19218 | IFAIL(33) = IFAIL(33) + 1 | |
19219 | IREJ = 1 | |
19220 | RETURN | |
19221 | ENDIF | |
19222 | CMASS2=2.D0*(PHEP(4,IG)*PHEP(4,IQ2)-PHEP(1,IG)*PHEP(1,IQ2) | |
19223 | & -PHEP(2,IG)*PHEP(2,IQ2)-PHEP(3,IG)*PHEP(3,IQ2)) | |
19224 | IF(CMASS2.LT.CUTM) THEN | |
19225 | IF(IDEB(73).GE.5) THEN | |
19226 | WRITE(LO,'(1X,A,3I4,4E10.3)') | |
19227 | & 'PHO_GLU2QU:REJECTION:IG,IQ1,IQ2,CMASS2',IG,IQ1,IQ2,CMASS2 | |
19228 | ENDIF | |
19229 | IFAIL(33) = IFAIL(33) + 1 | |
19230 | IREJ = 1 | |
19231 | RETURN | |
19232 | ENDIF | |
19233 | C | |
19234 | C calculate minimal z | |
19235 | ZMIN1 = (CUTM-SIGN(PHEP(5,IQ1)**2,PHEP(5,IQ1)))/CMASS1+EPS | |
19236 | ZMIN2 = (CUTM-SIGN(PHEP(5,IQ2)**2,PHEP(5,IQ2)))/CMASS2+EPS | |
19237 | ZMIN = MIN(ZMIN1,ZMIN2) | |
19238 | IF(MAX(ZMIN1,ZMIN2).GE.0.45D0) THEN | |
19239 | IF(IDEB(73).GE.5) THEN | |
19240 | WRITE(LO,'(1X,A,3I3,4E10.3)') | |
19241 | & 'PHO_GLU2QU:REJECTION:IG,IQ1,IQ2,ZMIN1,ZMIN2,P1*PG,P2*PG', | |
19242 | & IG,IQ1,IQ2,ZMIN1,ZMIN2,CMASS1,CMASS2 | |
19243 | ENDIF | |
19244 | IFAIL(33) = IFAIL(33) + 1 | |
19245 | IREJ = 1 | |
19246 | RETURN | |
19247 | ENDIF | |
19248 | ELSE | |
19249 | ZMIN = MIN(0.1D0,0.5D0/PHEP(4,IG)) | |
19250 | ENDIF | |
19251 | C | |
19252 | ZFRAC = PHO_GLUSPL(ZMIN) | |
19253 | IF((ZFRAC.LT.ZMIN1).OR.((1.D0-ZFRAC).LT.ZMIN2)) THEN | |
19254 | ZFRAC = 1.D0-ZFRAC | |
19255 | ENDIF | |
19256 | DO 200 I=1,4 | |
19257 | P1(I) = PHEP(I,IG)*ZFRAC | |
19258 | P2(I) = PHEP(I,IG)*(1.D0-ZFRAC) | |
19259 | 200 CONTINUE | |
19260 | C quark flavours | |
19261 | CMASS1 = SQRT(ZFRAC*CMASS1+SIGN(PHEP(5,IQ1)**2,PHEP(5,IQ1))) | |
19262 | CMASS2 = SQRT((1.D0-ZFRAC)*CMASS2 | |
19263 | & +SIGN(PHEP(5,IQ2)**2,PHEP(5,IQ2))) | |
19264 | CALL PHO_SEAFLA(IG,K,I,MIN(CMASS1,CMASS2)) | |
19265 | IF(ABS(IDHEP(IQ1)).GT.6) THEN | |
19266 | K = SIGN(ABS(K),IDHEP(IQ1)) | |
19267 | ELSE | |
19268 | K = -SIGN(ABS(K),IDHEP(IQ1)) | |
19269 | ENDIF | |
19270 | C colors | |
19271 | IF(K.GT.0) THEN | |
19272 | IC1 = MAX(ICOLOR(1,IG),ICOLOR(2,IG)) | |
19273 | IC2 = MIN(ICOLOR(1,IG),ICOLOR(2,IG)) | |
19274 | ELSE | |
19275 | IC1 = MIN(ICOLOR(1,IG),ICOLOR(2,IG)) | |
19276 | IC2 = MAX(ICOLOR(1,IG),ICOLOR(2,IG)) | |
19277 | ENDIF | |
19278 | C register new partons | |
19279 | CALL PHO_REGPAR(-1,K,0,IG,0,P1(1),P1(2),P1(3),P1(4), | |
19280 | & IPHIST(1,IG),0,IC1,0,IPOS,1) | |
19281 | CALL PHO_REGPAR(-1,-K,0,IG,0,P2(1),P2(2),P2(3),P2(4), | |
19282 | & IPHIST(1,IG),0,IC2,0,IPOS,1) | |
19283 | C debug output | |
19284 | IF(IDEB(73).GE.20) THEN | |
19285 | WRITE(LO,'(1X,A,/1X,A,3I3,5E10.3)') | |
19286 | & 'PHO_GLU2QU:',' IG,IQ1,IQ2,ZMIN1,2,Z,P1*PG,P2*PG', | |
19287 | & IG,IQ1,IQ2,ZMIN1,ZMIN2,ZFRAC,CMASS1,CMASS2 | |
19288 | WRITE(LO,'(1X,A,4I5)') ' flavours, colors ', | |
19289 | & K,-K,IC1,IC2 | |
19290 | ENDIF | |
19291 | END | |
19292 | ||
19293 | *$ CREATE PHO_GLUSPL.FOR | |
19294 | *COPY PHO_GLUSPL | |
19295 | CDECK ID>, PHO_GLUSPL | |
19296 | DOUBLE PRECISION FUNCTION PHO_GLUSPL(ZMIN) | |
19297 | C********************************************************************* | |
19298 | C | |
19299 | C calculate quark - antiquark light cone momentum fractions | |
19300 | C according to Altarelli-Parisi g->q aq splitting function | |
19301 | C (symmetric z interval assumed) | |
19302 | C | |
19303 | C input: ZMIN minimal Z value allowed, | |
19304 | C 1-ZMIN maximal Z value allowed | |
19305 | C | |
19306 | C******************************************************************** | |
19307 | IMPLICIT DOUBLE PRECISION (A-H,O-Z) | |
19308 | SAVE | |
19309 | ||
19310 | PARAMETER ( ALEXP= 0.3333333333D0, | |
19311 | & DEPS = 1.D-10 ) | |
19312 | ||
19313 | C input/output channels | |
19314 | INTEGER LI,LO | |
19315 | COMMON /POINOU/ LI,LO | |
19316 | C event debugging information | |
19317 | INTEGER NMAXD | |
19318 | PARAMETER (NMAXD=100) | |
19319 | INTEGER IDEB,KSPOM,KHPOM,KSREG,KHDIR,KACCEP,KSTRG,KHTRG,KSLOO, | |
19320 | & KHLOO,KSDPO,KHDPO,KEVENT,KSOFT,KHARD | |
19321 | COMMON /PODEBG/ IDEB(NMAXD),KSPOM,KHPOM,KSREG,KHDIR,KACCEP,KSTRG, | |
19322 | & KHTRG,KSLOO,KHLOO,KSDPO,KHDPO,KEVENT,KSOFT,KHARD | |
19323 | ||
19324 | IF(ZMIN.GE.0.5D0) THEN | |
19325 | IF(IDEB(69).GT.2) THEN | |
19326 | WRITE(LO,'(1X,A,E12.4)') 'PHO_GLUSPL: ZMIN>=0.5',ZMIN | |
19327 | ENDIF | |
19328 | ZZ=0.D0 | |
19329 | GOTO 1000 | |
19330 | ELSE IF(ZMIN.LE.0.D0) THEN | |
19331 | IF(IDEB(69).GT.2) THEN | |
19332 | WRITE(LO,'(1X,A,E12.4)') 'PHO_GLUSPL: ZMIN<=0',ZMIN | |
19333 | ENDIF | |
19334 | ZMINL = DEPS | |
19335 | ELSE | |
19336 | ZMINL = ZMIN | |
19337 | ENDIF | |
19338 | ||
19339 | ZMAX = 1.D0-ZMINL | |
19340 | XI = DT_RNDM(ZMAX) | |
19341 | ZZ = ((1.D0-XI)*ZMINL**3+XI*ZMAX**3)**ALEXP | |
19342 | IF(DT_RNDM(ZZ).LT.0.5D0) ZZ = 1.D0-ZZ | |
19343 | ||
19344 | 1000 CONTINUE | |
19345 | IF(IDEB(69).GE.10) THEN | |
19346 | WRITE(LO,'(1X,A,2E12.4)') 'PHO_GLUSPL: ZMIN,Z ',ZMIN,ZZ | |
19347 | ENDIF | |
19348 | PHO_GLUSPL = ZZ | |
19349 | END | |
19350 | ||
19351 | *$ CREATE PHO_STDPAR.FOR | |
19352 | *COPY PHO_STDPAR | |
19353 | CDECK ID>, PHO_STDPAR | |
19354 | SUBROUTINE PHO_STDPAR(IJM1,IJM2,IGEN,MSPOM,MSREG,MHPOM,MHDIR,IREJ) | |
19355 | C*********************************************************************** | |
19356 | C | |
19357 | C select the initial parton x-fractions and flavors and | |
19358 | C the final parton momenta and flavours | |
19359 | C for standard Pomeron/Reggeon cuts | |
19360 | C | |
19361 | C input: IJM1 index of mother particle 1 in /POEVT1/ | |
19362 | C IJM2 index of mother particle 2 in /POEVT1/ | |
19363 | C IGEN production process of mother particles | |
19364 | C MSPOM soft cut Pomerons | |
19365 | C MHPOM hard or semihard cut Pomerons | |
19366 | C MSREG soft cut Reggeons | |
19367 | C MHDIR direct hard processes | |
19368 | C | |
19369 | C IJM1 -1 initialization of statistics | |
19370 | C -2 output of statistics | |
19371 | C | |
19372 | C output: partons are directly written to /POEVT1/,/POEVT2/ | |
19373 | C | |
19374 | C structure of /POSOFT/ | |
19375 | C XS1(I),XS2(I): x-values of initial partons | |
19376 | C IJSI1(I),IJSI2(I): flavor of initial parton | |
19377 | C 0 gluon | |
19378 | C 1,2,3,4 quarks | |
19379 | C negative antiquarks | |
19380 | C IJSF1(I),IJSF2(I): flavor of final state partons | |
19381 | C PSOFT1(I,J),PSOFT2(I,J): final part. momentum and energy | |
19382 | C J=1 PX | |
19383 | C =2 PY | |
19384 | C =3 PZ | |
19385 | C =4 ENERGY | |
19386 | C | |
19387 | C*********************************************************************** | |
19388 | IMPLICIT DOUBLE PRECISION (A-H,O-Z) | |
19389 | SAVE | |
19390 | ||
19391 | PARAMETER (RHOMAS = 0.766D0, | |
19392 | & DEPS = 1.D-10, | |
19393 | & TINY = 1.D-10) | |
19394 | ||
19395 | C input/output channels | |
19396 | INTEGER LI,LO | |
19397 | COMMON /POINOU/ LI,LO | |
19398 | C event debugging information | |
19399 | INTEGER NMAXD | |
19400 | PARAMETER (NMAXD=100) | |
19401 | INTEGER IDEB,KSPOM,KHPOM,KSREG,KHDIR,KACCEP,KSTRG,KHTRG,KSLOO, | |
19402 | & KHLOO,KSDPO,KHDPO,KEVENT,KSOFT,KHARD | |
19403 | COMMON /PODEBG/ IDEB(NMAXD),KSPOM,KHPOM,KSREG,KHDIR,KACCEP,KSTRG, | |
19404 | & KHTRG,KSLOO,KHLOO,KSDPO,KHDPO,KEVENT,KSOFT,KHARD | |
19405 | C model switches and parameters | |
19406 | CHARACTER*8 MDLNA | |
19407 | INTEGER ISWMDL,IPAMDL | |
19408 | DOUBLE PRECISION PARMDL | |
19409 | COMMON /POMDLS/ MDLNA(50),ISWMDL(50),PARMDL(400),IPAMDL(400) | |
19410 | C some constants | |
19411 | DOUBLE PRECISION PI,PI2,PI4,GEV2MB,Q_ch,Q_ch2,Q_ch4 | |
19412 | COMMON /POCONS/ PI,PI2,PI4,GEV2MB, | |
19413 | & Q_ch(-6:6),Q_ch2(-6:6),Q_ch4(-6:6) | |
19414 | C general process information | |
19415 | INTEGER IPROCE,IDNODF,IDIFR1,IDIFR2,IDDPOM,IPRON | |
19416 | COMMON /POPRCS/ IPROCE,IDNODF,IDIFR1,IDIFR2,IDDPOM,IPRON(15,4) | |
19417 | C global event kinematics and particle IDs | |
19418 | INTEGER IFPAP,IFPAB | |
19419 | DOUBLE PRECISION ECM,PCM,PMASS,PVIRT | |
19420 | COMMON /POGCMS/ ECM,PCM,PMASS(2),PVIRT(2),IFPAP(2),IFPAB(2) | |
19421 | C data of c.m. system of Pomeron / Reggeon exchange | |
19422 | INTEGER NPOSP,IDPDG1,IDBAM1,IDPDG2,IDBAM2 | |
19423 | DOUBLE PRECISION ECMP,PCMP,PMASSP,PVIRTP,GAMBEP, | |
19424 | & SIDP,CODP,SIFP,COFP | |
19425 | COMMON /POPCMS/ ECMP,PCMP,PMASSP(2),PVIRTP(2),GAMBEP(4), | |
19426 | & SIDP,CODP,SIFP,COFP,NPOSP(2), | |
19427 | & IDPDG1,IDBAM1,IDPDG2,IDBAM2 | |
19428 | C nucleon-nucleus / nucleus-nucleus interface to DPMJET | |
19429 | INTEGER IDEQP,IDEQB,IHFLD,IHFLS | |
19430 | DOUBLE PRECISION ECMN,PCMN,SECM,SPCM,XPSUB,XTSUB | |
19431 | COMMON /POHDFL/ ECMN,PCMN,SECM,SPCM,XPSUB,XTSUB, | |
19432 | & IDEQP(2),IDEQB(2),IHFLD(2,2),IHFLS(2) | |
19433 | C obsolete cut-off information | |
19434 | DOUBLE PRECISION PTCUT,PTANO,FPS,FPH,PSOMIN,XSOMIN | |
19435 | COMMON /POCUT1/ PTCUT(4),PTANO(4),FPS(4),FPH(4),PSOMIN,XSOMIN | |
19436 | C currently activated parton density parametrizations | |
19437 | CHARACTER*8 PDFNAM | |
19438 | INTEGER IPARID,IPAVA,ITYPE,IGRP,ISET,IEXT,NPAOLD | |
19439 | DOUBLE PRECISION PDFLAM,PDFQ2M | |
19440 | COMMON /POPPDF/ PDFLAM(2),PDFQ2M(2),PDFNAM(2),IPARID(2), | |
19441 | & IPAVA(2),ITYPE(2),IGRP(2),ISET(2),IEXT(2),NPAOLD | |
19442 | C hard scattering parameters used for most recent hard interaction | |
19443 | INTEGER NFbeta,NF | |
19444 | DOUBLE PRECISION ALQCD2,BQCD | |
19445 | COMMON /POHAPA/ ALQCD2(3,4),BQCD(4),NFbeta,NF | |
19446 | C particles created by initial state evolution | |
19447 | INTEGER MXISR1,MXISR2 | |
19448 | PARAMETER ( MXISR1 = 150, MXISR2 = 50 ) | |
19449 | INTEGER IFLISR,IPOISR,IMXISR | |
19450 | DOUBLE PRECISION PHISR | |
19451 | COMMON /POPISR/ IFLISR(2,MXISR1),PHISR(2,4,MXISR1), | |
19452 | & IPOISR(2,2,MXISR2),IMXISR(2) | |
19453 | C light-cone x fractions and c.m. momenta of soft cut string ends | |
19454 | INTEGER MAXSOF | |
19455 | PARAMETER ( MAXSOF = 50 ) | |
19456 | INTEGER IJSI2,IJSI1 | |
19457 | DOUBLE PRECISION XS1,XS2,PSOFT1,PSOFT2 | |
19458 | COMMON /POSOFT/ XS1(MAXSOF),XS2(MAXSOF), | |
19459 | & PSOFT1(4,MAXSOF),PSOFT2(4,MAXSOF), | |
19460 | & IJSI1(MAXSOF),IJSI2(MAXSOF) | |
19461 | C table of particle indices for recursive PHOJET calls | |
19462 | INTEGER MAXIPX | |
19463 | PARAMETER ( MAXIPX = 100 ) | |
19464 | INTEGER IPOPOS,IPORES,IPOIX1,IPOIX2,IPOIX3 | |
19465 | COMMON /PORECU/ IPOPOS(2,MAXIPX),IPORES(MAXIPX), | |
19466 | & IPOIX1,IPOIX2,IPOIX3 | |
19467 | C hard scattering data | |
19468 | INTEGER MSCAHD | |
19469 | PARAMETER ( MSCAHD = 50 ) | |
19470 | INTEGER LSCAHD,LSC1HD,LSIDX, | |
19471 | & NINHD,N0INHD,NIVAL,N0IVAL,NOUTHD,NBRAHD,NPROHD | |
19472 | DOUBLE PRECISION PPH,PTHD,ETAHD,Q2SCA,PDFVA,XHD,VHD,X0HD | |
19473 | COMMON /POHSLT/ LSCAHD,LSC1HD,LSIDX(MSCAHD), | |
19474 | & PPH(8*MSCAHD,2),PTHD(MSCAHD),ETAHD(MSCAHD,2), | |
19475 | & Q2SCA(MSCAHD,2),PDFVA(MSCAHD,2), | |
19476 | & XHD(MSCAHD,2),VHD(MSCAHD),X0HD(MSCAHD,2), | |
19477 | & NINHD(MSCAHD,2),N0INHD(MSCAHD,2), | |
19478 | & NIVAL(MSCAHD,2),N0IVAL(MSCAHD,2), | |
19479 | & NOUTHD(MSCAHD,2),NBRAHD(MSCAHD,2),NPROHD(MSCAHD) | |
19480 | C standard particle data interface | |
19481 | INTEGER NMXHEP | |
19482 | PARAMETER (NMXHEP=4000) | |
19483 | INTEGER NEVHEP,NHEP,ISTHEP,IDHEP,JMOHEP,JDAHEP | |
19484 | DOUBLE PRECISION PHEP,VHEP | |
19485 | COMMON /POEVT1/ NEVHEP,NHEP,ISTHEP(NMXHEP),IDHEP(NMXHEP), | |
19486 | & JMOHEP(2,NMXHEP),JDAHEP(2,NMXHEP),PHEP(5,NMXHEP), | |
19487 | & VHEP(4,NMXHEP) | |
19488 | C extension to standard particle data interface (PHOJET specific) | |
19489 | INTEGER IMPART,IPHIST,ICOLOR | |
19490 | COMMON /POEVT2/ IMPART(NMXHEP),IPHIST(2,NMXHEP),ICOLOR(2,NMXHEP) | |
19491 | C internal rejection counters | |
19492 | INTEGER NMXJ | |
19493 | PARAMETER (NMXJ=60) | |
19494 | CHARACTER*10 REJTIT | |
19495 | INTEGER IFAIL | |
19496 | COMMON /POLOOP/ IFAIL(NMXJ),REJTIT(NMXJ) | |
19497 | C internal cross check information on hard scattering limits | |
19498 | DOUBLE PRECISION ETAMI,ETAMA,XXMI,XXMA | |
19499 | COMMON /POHLIM/ ETAMI(2,15),ETAMA(2,15),XXMI(2,15),XXMA(2,15) | |
19500 | C hard cross sections and MC selection weights | |
19501 | INTEGER Max_pro_2 | |
19502 | PARAMETER ( Max_pro_2 = 16 ) | |
19503 | INTEGER IHa_last,IHb_last,MH_pro_on,MH_tried, | |
19504 | & MH_acc_1,MH_acc_2 | |
19505 | DOUBLE PRECISION Hfac,HWgx,HSig,Hdpt,HEcm_last,HQ2a_last,HQ2b_last | |
19506 | COMMON /POHRCS/ Hfac(-1:Max_pro_2),HWgx(-1:Max_pro_2), | |
19507 | & HSig(-1:Max_pro_2),Hdpt(-1:Max_pro_2), | |
19508 | & HEcm_last,HQ2a_last,HQ2b_last,IHa_last,IHb_last, | |
19509 | & MH_pro_on(-1:Max_pro_2,0:4),MH_tried(-1:Max_pro_2,0:4), | |
19510 | & MH_acc_1(-1:Max_pro_2,0:4),MH_acc_2(-1:Max_pro_2,0:4) | |
19511 | ||
19512 | double precision pho_alphas | |
19513 | ||
19514 | DIMENSION PC(4),IFLA(2),ICI(2,2) | |
19515 | ||
19516 | IF(IJM1.EQ.-1) THEN | |
19517 | DO 116 I=1,15 | |
19518 | ETAMI(1,I) = 1.D10 | |
19519 | ETAMA(1,I) = -1.D10 | |
19520 | ETAMI(2,I) = 1.D10 | |
19521 | ETAMA(2,I) = -1.D10 | |
19522 | XXMI(1,I) = 1.D0 | |
19523 | XXMA(1,I) = 0.D0 | |
19524 | XXMI(2,I) = 1.D0 | |
19525 | XXMA(2,I) = 0.D0 | |
19526 | 116 CONTINUE | |
19527 | CALL PHO_HARSCA(IJM1,1) | |
19528 | CALL PHO_HARCOL(IJM1,0.D0,0,0,0,0,0,0,0,0,0,0,0,0) | |
19529 | ||
19530 | RETURN | |
19531 | ||
19532 | ELSE IF(IJM1.EQ.-2) THEN | |
19533 | ||
19534 | C output internal statistics | |
19535 | IF(IDEB(23).GE.1) THEN | |
19536 | WRITE(LO,'(/1X,A)') | |
19537 | & 'kinematic limits particle c (ETAMIN,ETAMAX,XMIN,XMAX)' | |
19538 | DO 117 I=1,15 | |
19539 | WRITE(LO,'(5X,I3,4E13.5)') | |
19540 | & I,ETAMI(1,I),ETAMA(1,I),XXMI(1,I),XXMA(1,I) | |
19541 | 117 CONTINUE | |
19542 | WRITE(LO,'(1X,A)') | |
19543 | & 'kinematic limits particle d (ETAMIN,ETAMAX,XMIN,XMAX)' | |
19544 | DO 118 I=1,15 | |
19545 | WRITE(LO,'(5X,I3,4E13.5)') | |
19546 | & I,ETAMI(2,I),ETAMA(2,I),XXMI(2,I),XXMA(2,I) | |
19547 | 118 CONTINUE | |
19548 | ENDIF | |
19549 | CALL PHO_HARSCA(IJM1,1) | |
19550 | CALL PHO_HARCOL(IJM1,0.D0,0,0,0,0,0,0,0,0,0,0,0,0) | |
19551 | ||
19552 | RETURN | |
19553 | ENDIF | |
19554 | ||
19555 | IREJ = 0 | |
19556 | C debug output | |
19557 | IF(IDEB(23).GT.5) WRITE(LO,221) IJM1,IJM2,MSPOM,MHPOM,MSREG,MHDIR | |
19558 | 221 FORMAT (' PHO_STDPAR: JM1/2,MSPOM,MHPOM,MSREG,MHDIR ',6I5) | |
19559 | ||
19560 | C get mother data (exchange if first particle is a pomeron) | |
19561 | IF((IDHEP(IJM1).EQ.990).AND.(IFPAP(1).NE.990)) THEN | |
19562 | JM1 = IJM2 | |
19563 | JM2 = IJM1 | |
19564 | ELSE | |
19565 | JM1 = IJM1 | |
19566 | JM2 = IJM2 | |
19567 | ENDIF | |
19568 | ||
19569 | NPOSP(1) = JM1 | |
19570 | NPOSP(2) = JM2 | |
19571 | IDPDG1 = IDHEP(JM1) | |
19572 | IDBAM1 = IMPART(JM1) | |
19573 | IDPDG2 = IDHEP(JM2) | |
19574 | IDBAM2 = IMPART(JM2) | |
19575 | ||
19576 | C store current status of /POEVT1/ | |
19577 | KHPOMS = KHPOM | |
19578 | KSPOMS = KSPOM | |
19579 | KSREGS = KSREG | |
19580 | KHDIRS = KHDIR | |
19581 | NHEPS = NHEP | |
19582 | IPOIS1 = IPOIX1 | |
19583 | IPOIS2 = IPOIX2 | |
19584 | ||
19585 | C get nominal masses (photons: VDM assumption) | |
19586 | DELMAS = 0.D0 | |
19587 | IF(IDHEP(JM1).EQ.22) THEN | |
19588 | PMASSP(1) = RHOMAS+DELMAS | |
19589 | PVIRTP(1) = PHEP(5,JM1)**2 | |
19590 | ELSE | |
19591 | PMASSP(1) = PHO_PMASS(IDBAM1,0)+DELMAS | |
19592 | PVIRTP(1) = 0.D0 | |
19593 | ENDIF | |
19594 | IF(IDHEP(JM2).EQ.22) THEN | |
19595 | PMASSP(2) = RHOMAS+DELMAS | |
19596 | PVIRTP(2) = PHEP(5,JM2)**2 | |
19597 | ELSE | |
19598 | PMASSP(2) = PHO_PMASS(IDBAM2,0)+DELMAS | |
19599 | PVIRTP(2) = 0.D0 | |
19600 | ENDIF | |
19601 | ||
19602 | C calculate c.m. energy and check kinematics | |
19603 | PC(1) = PHEP(1,JM1)+PHEP(1,JM2) | |
19604 | PC(2) = PHEP(2,JM1)+PHEP(2,JM2) | |
19605 | PC(3) = PHEP(3,JM1)+PHEP(3,JM2) | |
19606 | PC(4) = PHEP(4,JM1)+PHEP(4,JM2) | |
19607 | SS = (PC(4)+PC(3))*(PC(4)-PC(3))-PC(1)**2-PC(2)**2 | |
19608 | ||
19609 | IF(SS.LE.(PMASSP(1)+PMASSP(2)+DEPS)**2) THEN | |
19610 | WRITE(LO,'(/,1X,2A)') 'PHO_STDPAR: ', | |
19611 | & 'energy smaller than two-particle threshold (event rejected)' | |
19612 | CALL PHO_PREVNT(1) | |
19613 | IREJ = 5 | |
19614 | GOTO 150 | |
19615 | ENDIF | |
19616 | ECMP = SQRT(SS) | |
19617 | ||
19618 | IF(IDEB(23).GE.5) THEN | |
19619 | WRITE(LO,'(1X,2A,2I7,E12.4)') 'PHO_STDPAR: ', | |
19620 | & 'particles, available energy:',IDHEP(JM1),IDHEP(JM2),ECMP | |
19621 | IF(IDEB(23).GE.25) CALL PHO_PREVNT(0) | |
19622 | ENDIF | |
19623 | ||
19624 | C Lorentz transformation into c.m. system | |
19625 | DO 10 I=1,4 | |
19626 | GAMBEP(I) = PC(I)/ECMP | |
19627 | 10 CONTINUE | |
19628 | CALL PHO_ALTRA(GAMBEP(4),-GAMBEP(1),-GAMBEP(2),-GAMBEP(3), | |
19629 | & PHEP(1,JM1),PHEP(2,JM1),PHEP(3,JM1), | |
19630 | & PHEP(4,JM1),PTOT1,PC(1),PC(2),PC(3),PC(4)) | |
19631 | C rotation angle: particle 1 moves along +z | |
19632 | CODP = PC(3)/PTOT1 | |
19633 | SIDP = SQRT(PC(1)**2+PC(2)**2)/PTOT1 | |
19634 | COFP = 1.D0 | |
19635 | SIFP = 0.D0 | |
19636 | IF(PTOT1*SIDP.GT.1.D-5) THEN | |
19637 | COFP = PC(1)/(SIDP*PTOT1) | |
19638 | SIFP = PC(2)/(SIDP*PTOT1) | |
19639 | ANORF = SQRT(COFP*COFP+SIFP*SIFP) | |
19640 | COFP = COFP/ANORF | |
19641 | SIFP = SIFP/ANORF | |
19642 | ENDIF | |
19643 | C get CM momentum | |
19644 | XM12 = PMASSP(1)**2 | |
19645 | XM22 = PMASSP(2)**2 | |
19646 | PCMP = PHO_XLAM(SS,XM12,XM22)/(2.D0*ECMP) | |
19647 | ||
19648 | C find particle combination | |
19649 | II = 0 | |
19650 | IF(IDPDG2.EQ.IFPAP(2)) THEN | |
19651 | IF(IDPDG1.EQ.IFPAP(1)) II = 1 | |
19652 | ELSE IF(IDPDG2.EQ.990) THEN | |
19653 | IF(IDPDG1.EQ.IFPAP(1)) THEN | |
19654 | II = 2 | |
19655 | ELSE IF(IDPDG1.EQ.IFPAP(2)) THEN | |
19656 | II = 3 | |
19657 | ELSE IF(IDPDG1.EQ.990) THEN | |
19658 | II = 4 | |
19659 | ENDIF | |
19660 | ENDIF | |
19661 | IF(II.EQ.0) THEN | |
19662 | IF(ISWMDL(14).GT.0) THEN | |
19663 | II = 1 | |
19664 | ELSE | |
19665 | WRITE(LO,'(/1X,2A,2I8)') 'PHO_STDPAR:ERROR: ', | |
19666 | & 'invalid particle combination:',IDPDG1,IDPDG2 | |
19667 | CALL PHO_ABORT | |
19668 | ENDIF | |
19669 | ENDIF | |
19670 | ||
19671 | C select parton distribution functions from tables | |
19672 | IF((MHPOM+MHDIR).GT.0) THEN | |
19673 | CALL PHO_ACTPDF(IDPDG1,1) | |
19674 | CALL PHO_ACTPDF(IDPDG2,2) | |
19675 | C initialize alpha_s calculation | |
19676 | DUMMY = PHO_ALPHAS(0.D0,-4) | |
19677 | ENDIF | |
19678 | ||
19679 | C interpolate hard cross sections and rejection weights | |
19680 | CALL PHO_HARINT(II,ECMP,PVIRTP(1),PVIRTP(2), | |
19681 | & -1,Max_pro_2,1,4,MSPOM+MHPOM+MHDIR) | |
19682 | ||
19683 | NTRY = 10 | |
19684 | ||
19685 | C position of first particle added to /POEVT2/ | |
19686 | NLOR1 = NHEP+1 | |
19687 | ||
19688 | C ---------------- direct processes ----------------- | |
19689 | ||
19690 | IF(MHDIR.EQ.1) THEN | |
19691 | CALL PHO_HARDIR(II,IVAL1,IVAL2,MSPAR1,MSPAR2,MHPAR1,MHPAR2,IREJ) | |
19692 | IF(IREJ.EQ.50) RETURN | |
19693 | IF(IREJ.NE.0) GOTO 150 | |
19694 | C write comments to /POEVT1/ | |
19695 | CALL PHO_REGPAR(25,II,NPROHD(1),IDPDG1,IDPDG2,X0HD(1,1), | |
19696 | & X0HD(1,2),PTHD(1),VHD(1),N0INHD(1,1),N0INHD(1,2), | |
19697 | & IPHO_CNV1(NOUTHD(1,1)),IPHO_CNV1(NOUTHD(1,2)),IPOS,1) | |
19698 | CALL PHO_REGPAR(20,IPHO_CNV1(N0INHD(1,1)),IPDF1,JM1,JM2, | |
19699 | & PPH(1,1),PPH(2,1),PPH(3,1),Q2SCA(1,1),100,NBRAHD(1,1), | |
19700 | & ICA1,ICA2,IPOS,1) | |
19701 | CALL PHO_REGPAR(20,IPHO_CNV1(N0INHD(1,2)),IPDF2,JM2,JM1, | |
19702 | & PPH(1,2),PPH(2,2),PPH(3,2),Q2SCA(1,2),100,NBRAHD(1,2), | |
19703 | & ICA1,ICA2,IPOS,1) | |
19704 | CALL PHO_REGPAR(21,NOUTHD(1,1),IPDF1,JM1,JM2,PPH(5,1), | |
19705 | & PPH(6,1),PPH(7,1),PPH(8,1),100,NBRAHD(1,1),ICA1,ICA2, | |
19706 | & IPOS1,1) | |
19707 | CALL PHO_REGPAR(21,NOUTHD(1,2),IPDF2,JM2,JM1,PPH(5,2), | |
19708 | & PPH(6,2),PPH(7,2),PPH(8,2),100,NBRAHD(1,2),ICA1,ICA2, | |
19709 | & IPOS2,1) | |
19710 | ||
19711 | C soft spectator partons | |
19712 | ICA1 = 0 | |
19713 | ICA2 = 0 | |
19714 | ICB1 = 0 | |
19715 | ICB2 = 0 | |
19716 | IPDF1 = 0 | |
19717 | IPDF2 = 0 | |
19718 | ||
19719 | C single resolved: QCD compton scattering | |
19720 | C ------------------------------ | |
19721 | IF(NPROHD(1).EQ.10) THEN | |
19722 | C register hadron remnant | |
19723 | CALL PHO_HARREM(JM2,JM1,IGEN,-1,IVAL2,1,ICB1,ICB2,IUSED,IREJ) | |
19724 | IPDF2 = 1000*IGRP(2)+ISET(2) | |
19725 | ELSE IF(NPROHD(1).EQ.12) THEN | |
19726 | C register hadron remnant | |
19727 | CALL PHO_HARREM(JM1,JM2,IGEN,1,IVAL1,1,ICA1,ICA2,IUSED,IREJ) | |
19728 | IPDF1 = 1000*IGRP(1)+ISET(1) | |
19729 | ||
19730 | C single resolved: photon gluon fusion | |
19731 | C --------------------------- | |
19732 | ELSE IF(NPROHD(1).EQ.11) THEN | |
19733 | C register hadron remnant | |
19734 | CALL PHO_HARREM(JM2,JM1,IGEN,-1,IVAL2,1,ICB1,ICB2,IUSED,IREJ) | |
19735 | IPDF2 = 1000*IGRP(2)+ISET(2) | |
19736 | ELSE IF(NPROHD(1).EQ.13) THEN | |
19737 | C register hadron remnant | |
19738 | CALL PHO_HARREM(JM1,JM2,IGEN,1,IVAL1,1,ICA1,ICA2,IUSED,IREJ) | |
19739 | IPDF1 = 1000*IGRP(1)+ISET(1) | |
19740 | ||
19741 | C direct process (no remnant) | |
19742 | C ---------------------------- | |
19743 | ELSE IF(NPROHD(1).EQ.14) THEN | |
19744 | ||
19745 | ENDIF | |
19746 | ||
19747 | C write final high-pt partons to POEVT1 | |
19748 | IF((ISWMDL(8).GE.2).AND.(NPROHD(1).NE.14)) THEN | |
19749 | ICI(1,1) = ICA1 | |
19750 | ICI(1,2) = ICA2 | |
19751 | ICI(2,1) = ICB1 | |
19752 | ICI(2,2) = ICB2 | |
19753 | I = 1 | |
19754 | IFLA(1) = NINHD(I,1) | |
19755 | IFLA(2) = NINHD(I,2) | |
19756 | C initial state radiation | |
19757 | DO 130 K=1,2 | |
19758 | DO 135 IPA=IPOISR(K,2,I),IPOISR(K,1,I)+1,-1 | |
19759 | KK = 1 | |
19760 | 137 CONTINUE | |
19761 | IFLB = IFLISR(K,IPA) | |
19762 | IF(ABS(IFLB).LE.6) THEN | |
19763 | C partons | |
19764 | IF(ICI(K,1)*ICI(K,2).NE.0) THEN | |
19765 | IF(IFLB.EQ.0) THEN | |
19766 | CALL PHO_SELCOL(ICI(K,1),ICI(K,2),IC1,IC2, | |
19767 | & ICI(K,1),ICI(K,2),3) | |
19768 | ELSE IF(IFLB.GT.0) THEN | |
19769 | CALL PHO_SELCOL(ICI(K,1),ICI(K,2),IC1,IC2, | |
19770 | & ICI(K,1),ICI(K,2),4) | |
19771 | ELSE | |
19772 | CALL PHO_SELCOL(ICI(K,1),ICI(K,2),ICI(K,1),ICI(K,2), | |
19773 | & IC1,IC2,4) | |
19774 | ENDIF | |
19775 | ELSE | |
19776 | IF((ICI(K,1)+ICI(K,2))*IFLB.LT.0) THEN | |
19777 | IF(IPA-KK.GT.IPOISR(K,1,I)) THEN | |
19778 | CALL PHO_SWAPI(IFLISR(K,IPA),IFLISR(K,IPA-KK)) | |
19779 | KK = KK+1 | |
19780 | GOTO 137 | |
19781 | ENDIF | |
19782 | ENDIF | |
19783 | IF(IFLB.EQ.0) THEN | |
19784 | CALL PHO_SELCOL(ICI(K,1),ICI(K,2),ICI(K,1),ICI(K,2), | |
19785 | & IC1,IC2,2) | |
19786 | ELSE | |
19787 | CALL PHO_SELCOL(ICI(K,1),ICI(K,2),IC1,IC2, | |
19788 | & ICI(K,1),ICI(K,2),2) | |
19789 | ENDIF | |
19790 | ENDIF | |
19791 | IIFL = IPHO_CNV1(IFLB) | |
19792 | IFLA(K) = IFLA(K)-IFLB | |
19793 | IST = -1 | |
19794 | ELSE | |
19795 | C other particle | |
19796 | IIFL = IFLB | |
19797 | IC1 = 0 | |
19798 | IC2 = 0 | |
19799 | IST = 1 | |
19800 | ENDIF | |
19801 | CALL PHO_REGPAR(IST,IIFL,0,JM1,JM2,PHISR(K,1,IPA), | |
19802 | & PHISR(K,2,IPA),PHISR(K,3,IPA),PHISR(K,4,IPA),I*100+K, | |
19803 | & IGEN,IC1,IC2,IPOS,1) | |
19804 | 135 CONTINUE | |
19805 | 130 CONTINUE | |
19806 | ICOLOR(1,IPOS1-2) = ICI(1,1) | |
19807 | ICOLOR(2,IPOS1-2) = ICI(1,2) | |
19808 | ICOLOR(1,IPOS1-1) = ICI(2,1) | |
19809 | ICOLOR(2,IPOS1-1) = ICI(2,2) | |
19810 | CALL PHO_HARCOL(NPROHD(I),VHD(I),IFLA(1),ICI(1,1),ICI(1,2), | |
19811 | & IFLA(2),ICI(2,1),ICI(2,2),NOUTHD(I,1),ICI(1,1),ICI(1,2), | |
19812 | & NOUTHD(I,2),ICI(2,1),ICI(2,2)) | |
19813 | ICOLOR(1,IPOS1) = ICI(1,1) | |
19814 | ICOLOR(2,IPOS1) = ICI(1,2) | |
19815 | ICOLOR(1,IPOS2) = ICI(2,1) | |
19816 | ICOLOR(2,IPOS2) = ICI(2,2) | |
19817 | DO 140 K=1,2 | |
19818 | IPA = IPOISR(K,1,I) | |
19819 | CALL PHO_REGPAR(-1,IPHO_CNV1(IFLISR(K,IPA)),0,JM1,JM2, | |
19820 | & PHISR(K,1,IPA),PHISR(K,2,IPA),PHISR(K,3,IPA), | |
19821 | & PHISR(K,4,IPA),-I*100,IGEN,ICI(K,1),ICI(K,2),IPOS,1) | |
19822 | 140 CONTINUE | |
19823 | ELSE | |
19824 | ICOLOR(1,IPOS1-2) = ICA1 | |
19825 | ICOLOR(2,IPOS1-2) = ICA2 | |
19826 | ICOLOR(1,IPOS1-1) = ICB1 | |
19827 | ICOLOR(2,IPOS1-1) = ICB2 | |
19828 | CALL PHO_HARCOL(NPROHD(1),VHD(1),NINHD(1,1),ICA1,ICA2, | |
19829 | & NINHD(1,2),ICB1,ICB2,NOUTHD(1,1),ICA1,ICA2, | |
19830 | & NOUTHD(1,2),ICB1,ICB2) | |
19831 | ICOLOR(1,IPOS1) = ICA1 | |
19832 | ICOLOR(2,IPOS1) = ICA2 | |
19833 | ICOLOR(1,IPOS2) = ICB1 | |
19834 | ICOLOR(2,IPOS2) = ICB2 | |
19835 | I = -1 | |
19836 | IF(ABS(NOUTHD(1,1)).GT.12) I = 1 | |
19837 | CALL PHO_REGPAR(I,IPHO_CNV1(NOUTHD(1,1)),0,JM1,JM2,PPH(5,1), | |
19838 | & PPH(6,1),PPH(7,1),PPH(8,1),-100,IGEN,ICA1,ICA2,IPOS,1) | |
19839 | CALL PHO_REGPAR(I,IPHO_CNV1(NOUTHD(1,2)),0,JM1,JM2,PPH(5,2), | |
19840 | & PPH(6,2),PPH(7,2),PPH(8,2),-100,IGEN,ICB1,ICB2,IPOS,1) | |
19841 | ENDIF | |
19842 | ||
19843 | C assign soft pt to spectators | |
19844 | IF(ISWMDL(18).EQ.0) THEN | |
19845 | IPOS2 = IPOS2-1 | |
19846 | CALL PHO_PARTPT(0,NLOR1,IPOS2,PTCUT(II),IREJ) | |
19847 | IF(IREJ.NE.0) THEN | |
19848 | IFAIL(26) = IFAIL(26) + 1 | |
19849 | GOTO 150 | |
19850 | ENDIF | |
19851 | ||
19852 | ENDIF | |
19853 | ||
19854 | C ----------------- resolved processes ------------------- | |
19855 | ||
19856 | C single Reggeon exchange | |
19857 | C ---------------------------- | |
19858 | ELSE IF((MSREG.EQ.1).AND.(MHPOM+MSPOM.EQ.0)) THEN | |
19859 | C flavours | |
19860 | CALL PHO_REGFLA(JM1,JM2,IFL1,IFL2,IREJ) | |
19861 | IF(IREJ.NE.0) THEN | |
19862 | IFAIL(24) = IFAIL(24)+1 | |
19863 | GOTO 150 | |
19864 | ENDIF | |
19865 | C colors | |
19866 | CALL PHO_SELCOL(0,0,ICA1,ICA2,ICB1,ICB2,1) | |
19867 | IF(((ABS(IFL1).GT.6).AND.(IFL1.GT.0)) | |
19868 | & .OR.((ABS(IFL1).LE.6).AND.(IFL1.LT.0))) THEN | |
19869 | CALL PHO_SWAPI(ICA1,ICB1) | |
19870 | ENDIF | |
19871 | ECMH = ECMP/2.D0 | |
19872 | ||
19873 | C registration | |
19874 | ||
19875 | C DPMJET call with special projectile / target | |
19876 | IF((IPAMDL(13).GT.0).AND.(IPOIX3.EQ.0).AND.(IPROCE.EQ.1)) THEN | |
19877 | CALL PHO_REGPAR(-1,IFL1,0,JM1,JM2,0.D0,0.D0,ECMH*XPSUB, | |
19878 | & ECMH*XPSUB,-1,IGEN,ICA1,0,IPOS1,1) | |
19879 | CALL PHO_REGPAR(-1,IFL2,0,JM1,JM2,0.D0,0.D0,-ECMH*XTSUB, | |
19880 | & ECMH*XTSUB,-1,IGEN,ICB1,0,IPOS2,1) | |
19881 | C default treatment | |
19882 | ELSE | |
19883 | CALL PHO_REGPAR(-1,IFL1,0,JM1,JM2,0.D0,0.D0,ECMH,ECMH, | |
19884 | & -1,IGEN,ICA1,0,IPOS1,1) | |
19885 | CALL PHO_REGPAR(-1,IFL2,0,JM1,JM2,0.D0,0.D0,-ECMH,ECMH, | |
19886 | & -1,IGEN,ICB1,0,IPOS2,1) | |
19887 | ENDIF | |
19888 | ||
19889 | C soft pt assignment | |
19890 | IF(ISWMDL(18).EQ.0) THEN | |
19891 | CALL PHO_PARTPT(0,IPOS1,IPOS2,PTCUT(II),IREJ) | |
19892 | IF(IREJ.NE.0) THEN | |
19893 | IFAIL(25) = IFAIL(25) + 1 | |
19894 | GOTO 150 | |
19895 | ENDIF | |
19896 | ENDIF | |
19897 | C | |
19898 | C multi Reggeon / Pomeron exchange | |
19899 | C---------------------------------------- | |
19900 | ELSE | |
19901 | C parton configuration | |
19902 | ||
19903 | CALL PHO_POMSCA(II,MSPOM,MHPOM,MSREG,IVAL1,IVAL2,MSPAR1,MSPAR2, | |
19904 | & MHPAR1,MHPAR2,IREJ) | |
19905 | ||
19906 | IF(IREJ.EQ.50) RETURN | |
19907 | IF(IREJ.NE.0) GOTO 150 | |
19908 | ||
19909 | C register particles | |
19910 | IF(IDEB(23).GE.15) WRITE(LO,'(1X,A,/15X,7I5)') | |
19911 | & 'PHO_STDPAR: MSPOM,MHPOM,MSREG,MSPAR1/2,IVAL1/2', | |
19912 | & MSPOM,MHPOM,MSREG,MSPAR1,MSPAR2,IVAL1,IVAL2 | |
19913 | ||
19914 | C register soft partons | |
19915 | IF(IVAL1.NE.0) THEN | |
19916 | IF(IVAL1.LT.0) THEN | |
19917 | IND1 = 3 | |
19918 | IVAL1=-IVAL1 | |
19919 | ELSE | |
19920 | IND1 = 2 | |
19921 | ENDIF | |
19922 | ELSE IF(MSPOM.EQ.0) THEN | |
19923 | IND1 = 4 | |
19924 | ELSE | |
19925 | IND1 = 1 | |
19926 | ENDIF | |
19927 | IF(IVAL2.NE.0) THEN | |
19928 | IF(IVAL2.LT.0) THEN | |
19929 | IND2 = 3 | |
19930 | IVAL2=-IVAL2 | |
19931 | ELSE | |
19932 | IND2 = 2 | |
19933 | ENDIF | |
19934 | ELSE IF(MSPOM.EQ.0) THEN | |
19935 | IND2 = 4 | |
19936 | ELSE | |
19937 | IND2 = 1 | |
19938 | ENDIF | |
19939 | ||
19940 | IF(IDEB(23).GE.20) WRITE(LO,'(1X,A,2I3,2X,2I3)') | |
19941 | & 'PHO_STDPAR: IND1/2,IVAL1/2',IND1,IND2,IVAL1,IVAL2 | |
19942 | ||
19943 | C soft Pomeron final states | |
19944 | C ----------------------------------- | |
19945 | K = MSPOM+MHPOM+MSREG | |
19946 | DO 50 I=1,MSPOM | |
19947 | ||
19948 | CALL PHO_POSPOM(II,IND1,IND2,IGEN,I,K,ISWAP,IREJ) | |
19949 | IF(IREJ.NE.0) THEN | |
19950 | IFAIL(8) = IFAIL(8) + 1 | |
19951 | GOTO 150 | |
19952 | ENDIF | |
19953 | C | |
19954 | 50 CONTINUE | |
19955 | ||
19956 | C soft Reggeon final states | |
19957 | C ----------------------------------------- | |
19958 | DO 75 I=1,MSREG | |
19959 | C flavours | |
19960 | CMASS1 = MIN(PSOFT1(4,IND1),PSOFT2(4,IND2)) | |
19961 | IF(DT_RNDM(CMASS1).LT.0.5D0) THEN | |
19962 | CALL PHO_SEAFLA(JM1,IFLA1,IFLB1,CMASS1) | |
19963 | ELSE | |
19964 | CALL PHO_SEAFLA(JM2,IFLA1,IFLB1,CMASS1) | |
19965 | ENDIF | |
19966 | C colors | |
19967 | CALL PHO_SELCOL(0,0,ICA1,ICA2,ICB1,ICB2,1) | |
19968 | IF(((ABS(IFLA1).GT.6).AND.(IFLA1.GT.0)) | |
19969 | & .OR.((ABS(IFLA1).LE.6).AND.(IFLA1.LT.0))) | |
19970 | & CALL PHO_SWAPI(ICA1,ICB1) | |
19971 | C registration | |
19972 | CALL PHO_REGPAR(-1,IFLA1,0,JM1,JM2,PSOFT1(1,IND1), | |
19973 | & PSOFT1(2,IND1),PSOFT1(3,IND1),PSOFT1(4,IND1), | |
19974 | & I,IGEN,ICA1,ICA2,IPOS1,1) | |
19975 | IND1 = IND1+1 | |
19976 | CALL PHO_REGPAR(-1,IFLB1,0,JM2,JM1,PSOFT2(1,IND2), | |
19977 | & PSOFT2(2,IND2),PSOFT2(3,IND2),PSOFT2(4,IND2), | |
19978 | & I,IGEN,ICB1,ICB2,IPOS2,1) | |
19979 | IND2 = IND2+1 | |
19980 | ||
19981 | IF(IDEB(23).GE.20) WRITE(LO,'(1X,A,/15X,6I4)') | |
19982 | & 'PHO_STDPAR: reg.cut: IND1,IND2,IFLA,IFLB,IPOS1,IPOS2', | |
19983 | & IND1-1,IND2-1,IFLA1,IFLB1,IPOS1,IPOS2 | |
19984 | ||
19985 | C soft pt assignment | |
19986 | IF(ISWMDL(18).EQ.0) THEN | |
19987 | CALL PHO_PARTPT(0,IPOS1,IPOS2,PTCUT(II),IREJ) | |
19988 | IF(IREJ.NE.0) THEN | |
19989 | IFAIL(25) = IFAIL(25) + 1 | |
19990 | GOTO 150 | |
19991 | ENDIF | |
19992 | ENDIF | |
19993 | ||
19994 | 75 CONTINUE | |
19995 | ||
19996 | C hard Pomeron final states | |
19997 | C ------------------------------------ | |
19998 | IND1 = MSPAR1 | |
19999 | IND2 = MSPAR2 | |
20000 | ||
20001 | DO 100 L=1,MHPOM | |
20002 | I = LSIDX(L) | |
20003 | ||
20004 | IFLI1 = IPHO_CNV1(N0INHD(I,1)) | |
20005 | IFLI2 = IPHO_CNV1(N0INHD(I,2)) | |
20006 | IFLO1 = IPHO_CNV1(NOUTHD(I,1)) | |
20007 | IFLO2 = IPHO_CNV1(NOUTHD(I,2)) | |
20008 | C write comments to /POEVT1/ | |
20009 | CALL PHO_REGPAR(25,II,NPROHD(I),IDPDG1,IDPDG2,X0HD(I,1), | |
20010 | & X0HD(I,2),PTHD(I),VHD(I),N0INHD(I,1),N0INHD(I,2), | |
20011 | & IFLO1,IFLO2,IPOS,1) | |
20012 | I1 = 8*I-7 | |
20013 | IPDF = 1000*IGRP(1)+ISET(1) | |
20014 | CALL PHO_REGPAR(20,IFLI1,IPDF,JM1,JM2,PPH(I1,1), | |
20015 | & PPH(I1+1,1),PPH(I1+2,1),Q2SCA(I,1),L*100,NBRAHD(I,1), | |
20016 | & ICA1,ICA2,IPOS,1) | |
20017 | IPDF = 1000*IGRP(2)+ISET(2) | |
20018 | CALL PHO_REGPAR(20,IFLI2,IPDF,JM2,JM1,PPH(I1,2), | |
20019 | & PPH(I1+1,2),PPH(I1+2,2),Q2SCA(I,2),L*100,NBRAHD(I,2), | |
20020 | & ICB1,ICB2,IPOS,1) | |
20021 | I1 = 8*I-3 | |
20022 | IPDF = 1000*IGRP(1)+ISET(1) | |
20023 | CALL PHO_REGPAR(21,IFLO1,IPDF,JM1,JM2,PPH(I1,1), | |
20024 | & PPH(I1+1,1),PPH(I1+2,1),PPH(I,1),L*100,NBRAHD(I,1), | |
20025 | & ICA1,ICA2,IPOS1,1) | |
20026 | IPDF = 1000*IGRP(2)+ISET(2) | |
20027 | CALL PHO_REGPAR(21,IFLO2,IPDF,JM2,JM1,PPH(I1,2), | |
20028 | & PPH(I1+1,2),PPH(I1+2,2),PPH(I,2),L*100,NBRAHD(I,2), | |
20029 | & ICB1,ICB2,IPOS2,1) | |
20030 | ||
20031 | C spectator partons belonging to hard interaction | |
20032 | IF(IVAL1.EQ.I) THEN | |
20033 | IVQ = 1 | |
20034 | IND = 1 | |
20035 | ELSE IF((MSPOM.EQ.0).AND.(L.EQ.1).AND.(IVAL1.EQ.0)) THEN | |
20036 | IVQ = 0 | |
20037 | IND = 1 | |
20038 | ELSE | |
20039 | IVQ = -1 | |
20040 | IND = IND1 | |
20041 | ENDIF | |
20042 | CALL PHO_HARREM(JM1,JM2,IGEN,L,IVQ,IND,ICA1,ICA2,IUSED,IREJ) | |
20043 | IF(IVQ.LT.0) IND1 = IND1-IUSED | |
20044 | IF(IVAL2.EQ.I) THEN | |
20045 | IVQ = 1 | |
20046 | IND = 1 | |
20047 | ELSE IF((MSPOM.EQ.0).AND.(L.EQ.1).AND.(IVAL2.EQ.0)) THEN | |
20048 | IVQ = 0 | |
20049 | IND = 1 | |
20050 | ELSE | |
20051 | IVQ = -1 | |
20052 | IND = IND2 | |
20053 | ENDIF | |
20054 | CALL PHO_HARREM(JM2,JM1,IGEN,-L,IVQ,IND,ICB1,ICB2,IUSED,IREJ) | |
20055 | IF(IVQ.LT.0) IND2 = IND2-IUSED | |
20056 | C | |
20057 | C register hard scattered partons | |
20058 | IF((ISWMDL(8).GE.2) | |
20059 | & .AND.((IPAMDL(101).NE.1).OR.(L.EQ.1))) THEN | |
20060 | ICI(1,1) = ICA1 | |
20061 | ICI(1,2) = ICA2 | |
20062 | ICI(2,1) = ICB1 | |
20063 | ICI(2,2) = ICB2 | |
20064 | IFLA(1) = NINHD(I,1) | |
20065 | IFLA(2) = NINHD(I,2) | |
20066 | C initial state radiation | |
20067 | DO 230 K=1,2 | |
20068 | DO 235 IPA=IPOISR(K,2,I),IPOISR(K,1,I)+1,-1 | |
20069 | KK = 1 | |
20070 | 237 CONTINUE | |
20071 | IFLB = IFLISR(K,IPA) | |
20072 | IF(ABS(IFLB).LE.6) THEN | |
20073 | C partons | |
20074 | IF(ICI(K,1)*ICI(K,2).NE.0) THEN | |
20075 | IF(IFLB.EQ.0) THEN | |
20076 | CALL PHO_SELCOL(ICI(K,1),ICI(K,2),IC1,IC2, | |
20077 | & ICI(K,1),ICI(K,2),3) | |
20078 | ELSE IF(IFLB.GT.0) THEN | |
20079 | CALL PHO_SELCOL(ICI(K,1),ICI(K,2),IC1,IC2, | |
20080 | & ICI(K,1),ICI(K,2),4) | |
20081 | ELSE | |
20082 | CALL PHO_SELCOL(ICI(K,1),ICI(K,2),ICI(K,1), | |
20083 | & ICI(K,2),IC1,IC2,4) | |
20084 | ENDIF | |
20085 | ELSE | |
20086 | IF((ICI(K,1)+ICI(K,2))*IFLB.LT.0) THEN | |
20087 | IF(IPA-KK.GT.IPOISR(K,1,I)) THEN | |
20088 | CALL PHO_SWAPI(IFLISR(K,IPA),IFLISR(K,IPA-KK)) | |
20089 | KK = KK+1 | |
20090 | GOTO 237 | |
20091 | ENDIF | |
20092 | ENDIF | |
20093 | IF(IFLB.EQ.0) THEN | |
20094 | CALL PHO_SELCOL(ICI(K,1),ICI(K,2),ICI(K,1), | |
20095 | & ICI(K,2),IC1,IC2,2) | |
20096 | ELSE | |
20097 | CALL PHO_SELCOL(ICI(K,1),ICI(K,2),IC1,IC2, | |
20098 | & ICI(K,1),ICI(K,2),2) | |
20099 | ENDIF | |
20100 | ENDIF | |
20101 | IIFL = IPHO_CNV1(IFLB) | |
20102 | IFLA(K) = IFLA(K)-IFLB | |
20103 | IST = -1 | |
20104 | ELSE | |
20105 | C other particles | |
20106 | IIFL = IFLB | |
20107 | IC1 = 0 | |
20108 | IC2 = 0 | |
20109 | IST = 1 | |
20110 | ENDIF | |
20111 | CALL PHO_REGPAR(IST,IIFL,0,JM1,JM2,PHISR(K,1,IPA), | |
20112 | & PHISR(K,2,IPA),PHISR(K,3,IPA),PHISR(K,4,IPA), | |
20113 | & L*100+K,IGEN,IC1,IC2,IPOS,1) | |
20114 | 235 CONTINUE | |
20115 | 230 CONTINUE | |
20116 | ICOLOR(1,IPOS1-2) = ICI(1,1) | |
20117 | ICOLOR(2,IPOS1-2) = ICI(1,2) | |
20118 | ICOLOR(1,IPOS1-1) = ICI(2,1) | |
20119 | ICOLOR(2,IPOS1-1) = ICI(2,2) | |
20120 | CALL PHO_HARCOL(NPROHD(I),VHD(I),IFLA(1),ICI(1,1),ICI(1,2), | |
20121 | & IFLA(2),ICI(2,1),ICI(2,2),NOUTHD(I,1),ICI(1,1),ICI(1,2), | |
20122 | & NOUTHD(I,2),ICI(2,1),ICI(2,2)) | |
20123 | ICOLOR(1,IPOS1) = ICI(1,1) | |
20124 | ICOLOR(2,IPOS1) = ICI(1,2) | |
20125 | ICOLOR(1,IPOS2) = ICI(2,1) | |
20126 | ICOLOR(2,IPOS2) = ICI(2,2) | |
20127 | DO 240 K=1,2 | |
20128 | IPA = IPOISR(K,1,I) | |
20129 | CALL PHO_REGPAR(-1,IPHO_CNV1(IFLISR(K,IPA)),0,JM1,JM2, | |
20130 | & PHISR(K,1,IPA),PHISR(K,2,IPA),PHISR(K,3,IPA), | |
20131 | & PHISR(K,4,IPA),-L*100,IGEN,ICI(K,1),ICI(K,2),IPOS,1) | |
20132 | 240 CONTINUE | |
20133 | ELSE | |
20134 | ICOLOR(1,IPOS1-2) = ICA1 | |
20135 | ICOLOR(2,IPOS1-2) = ICA2 | |
20136 | ICOLOR(1,IPOS1-1) = ICB1 | |
20137 | ICOLOR(2,IPOS1-1) = ICB2 | |
20138 | CALL PHO_HARCOL(NPROHD(I),VHD(I),NINHD(I,1),ICA1,ICA2, | |
20139 | & NINHD(I,2),ICB1,ICB2,NOUTHD(I,1),ICA1,ICA2, | |
20140 | & NOUTHD(I,2),ICB1,ICB2) | |
20141 | ICOLOR(1,IPOS1) = ICA1 | |
20142 | ICOLOR(2,IPOS1) = ICA2 | |
20143 | ICOLOR(1,IPOS2) = ICB1 | |
20144 | ICOLOR(2,IPOS2) = ICB2 | |
20145 | I1 = 8*I-3 | |
20146 | CALL PHO_REGPAR(-1,IPHO_CNV1(NOUTHD(I,1)),0,JM1,JM2, | |
20147 | & PPH(I1,1),PPH(I1+1,1),PPH(I1+2,1),PPH(I1+3,1),-L*100,IGEN, | |
20148 | & ICA1,ICA2,IPOS,1) | |
20149 | CALL PHO_REGPAR(-1,IPHO_CNV1(NOUTHD(I,2)),0,JM1,JM2, | |
20150 | & PPH(I1,2),PPH(I1+1,2),PPH(I1+2,2),PPH(I1+3,2),-L*100,IGEN, | |
20151 | & ICB1,ICB2,IPOS,1) | |
20152 | ENDIF | |
20153 | 100 CONTINUE | |
20154 | C end of resolved parton registration | |
20155 | ENDIF | |
20156 | ||
20157 | IF(MHDIR+MHPOM.GT.0) THEN | |
20158 | ||
20159 | IF(ISWMDL(29).GE.1) THEN | |
20160 | C primordial kt of hard scattering | |
20161 | CALL PHO_PRIMKT(1,NLOR1,NHEP,PTCUT(II),IREJ) | |
20162 | IF(IREJ.NE.0) THEN | |
20163 | IFAIL(27) = IFAIL(27)+1 | |
20164 | GOTO 150 | |
20165 | ENDIF | |
20166 | ELSE IF(ISWMDL(24).GE.0) THEN | |
20167 | C give "soft" pt only to soft (spectator) partons in hard processes | |
20168 | CALL PHO_PARTPT(1,NLOR1,NHEP,PTCUT(II),IREJ) | |
20169 | IF(IREJ.NE.0) THEN | |
20170 | IFAIL(26) = IFAIL(26)+1 | |
20171 | GOTO 150 | |
20172 | ENDIF | |
20173 | ENDIF | |
20174 | ||
20175 | ENDIF | |
20176 | ||
20177 | C give "soft" pt to partons in soft Pomerons | |
20178 | IF((MHDIR.EQ.0).AND.(ISWMDL(18).EQ.1)) THEN | |
20179 | CALL PHO_PARTPT(0,NLOR1,NHEP,PTCUT(II),IREJ) | |
20180 | IF(IREJ.NE.0) THEN | |
20181 | IFAIL(25) = IFAIL(25) + 1 | |
20182 | GOTO 150 | |
20183 | ENDIF | |
20184 | ENDIF | |
20185 | ||
20186 | C boost back to lab frame | |
20187 | CALL PHO_LTRHEP(NLOR1,NHEP,CODP,SIDP,COFP,SIFP,GAMBEP(4), | |
20188 | & GAMBEP(1),GAMBEP(2),GAMBEP(3)) | |
20189 | RETURN | |
20190 | ||
20191 | C rejection treatment | |
20192 | 150 CONTINUE | |
20193 | IFAIL(2) = IFAIL(2)+1 | |
20194 | C reset counters | |
20195 | KSPOM = KSPOMS | |
20196 | KHPOM = KHPOMS | |
20197 | KHDIR = KHDIRS | |
20198 | KSREG = KSREGS | |
20199 | C reset mother-daugther relations | |
20200 | JDAHEP(1,JM1) = 0 | |
20201 | JDAHEP(2,JM1) = 0 | |
20202 | JDAHEP(1,JM2) = 0 | |
20203 | JDAHEP(2,JM2) = 0 | |
20204 | ISTHEP(JM1) = 1 | |
20205 | ISTHEP(JM2) = 1 | |
20206 | IPOIX1 = IPOIS1 | |
20207 | IPOIX2 = IPOIS2 | |
20208 | NHEP = NHEPS | |
20209 | C debug | |
20210 | IF(IDEB(23).GT.2) WRITE(LO,'(/1X,A,4I6)') | |
20211 | & 'PHO_STDPAR: rejection (MSPOM,MHPOM,MSREG,MHDIR)', | |
20212 | & MSPOM,MHPOM,MSREG,MHDIR | |
20213 | RETURN | |
20214 | ||
20215 | END | |
20216 | ||
20217 | *$ CREATE PHO_HARCOL.FOR | |
20218 | *COPY PHO_HARCOL | |
20219 | CDECK ID>, PHO_HARCOL | |
20220 | SUBROUTINE PHO_HARCOL(MSPR,V,IP1,ICA1,ICA2,IP2,ICB1,ICB2, | |
20221 | & IP3,ICC1,ICC2,IP4,ICD1,ICD2) | |
20222 | C********************************************************************* | |
20223 | C | |
20224 | C calculate color flow for hard resolved process | |
20225 | C | |
20226 | C input: IP1..4 flavour of partons (PDG convention) | |
20227 | C V parton subprocess Mandelstam variable V = t/s | |
20228 | C (lightcone momenta assumed) | |
20229 | C ICA,ICB color labels | |
20230 | C MSPR process number | |
20231 | C -1 initialization of statistics | |
20232 | C -2 output of statistics | |
20233 | C | |
20234 | C output: ICC,ICD color label of final partons | |
20235 | C | |
20236 | C (it is possible to use the same variables for in and output) | |
20237 | C | |
20238 | C********************************************************************** | |
20239 | IMPLICIT DOUBLE PRECISION (A-H,O-Z) | |
20240 | SAVE | |
20241 | ||
20242 | C input/output channels | |
20243 | INTEGER LI,LO | |
20244 | COMMON /POINOU/ LI,LO | |
20245 | C event debugging information | |
20246 | INTEGER NMAXD | |
20247 | PARAMETER (NMAXD=100) | |
20248 | INTEGER IDEB,KSPOM,KHPOM,KSREG,KHDIR,KACCEP,KSTRG,KHTRG,KSLOO, | |
20249 | & KHLOO,KSDPO,KHDPO,KEVENT,KSOFT,KHARD | |
20250 | COMMON /PODEBG/ IDEB(NMAXD),KSPOM,KHPOM,KSREG,KHDIR,KACCEP,KSTRG, | |
20251 | & KHTRG,KSLOO,KHLOO,KSDPO,KHDPO,KEVENT,KSOFT,KHARD | |
20252 | C model switches and parameters | |
20253 | CHARACTER*8 MDLNA | |
20254 | INTEGER ISWMDL,IPAMDL | |
20255 | DOUBLE PRECISION PARMDL | |
20256 | COMMON /POMDLS/ MDLNA(50),ISWMDL(50),PARMDL(400),IPAMDL(400) | |
20257 | C names of hard scattering processes | |
20258 | INTEGER Max_pro_1 | |
20259 | PARAMETER ( Max_pro_1 = 16 ) | |
20260 | CHARACTER*18 PROC | |
20261 | COMMON /POHPRO/ PROC(0:Max_pro_1) | |
20262 | ||
20263 | DIMENSION PC(3),ICONF(8,5),IRECN(8,2) | |
20264 | ||
20265 | C initialization | |
20266 | IF(MSPR.EQ.-1) THEN | |
20267 | DO 200 I=1,8 | |
20268 | DO 210 K=1,5 | |
20269 | ICONF(I,K) = 0 | |
20270 | 210 CONTINUE | |
20271 | IRECN(I,1) = 0 | |
20272 | IRECN(I,2) = 0 | |
20273 | 200 CONTINUE | |
20274 | RETURN | |
20275 | C output of statistics | |
20276 | ELSE IF(MSPR.EQ.-2) THEN | |
20277 | IF(IDEB(26).LT.1) RETURN | |
20278 | WRITE(LO,'(/1X,A,/1X,A)') | |
20279 | & 'PHO_HARCOL: sampled color configurations', | |
20280 | & '----------------------------------------' | |
20281 | WRITE(LO,'(6X,A,15X,A)') | |
20282 | & 'diagram color configurations (1-4)','sum' | |
20283 | DO 300 I=1,8 | |
20284 | DO 310 K=1,4 | |
20285 | ICONF(I,5) = ICONF(I,5) + ICONF(I,K) | |
20286 | 310 CONTINUE | |
20287 | WRITE(LO,'(2X,A,4I11,I12)') PROC(I),(ICONF(I,K),K=1,5) | |
20288 | 300 CONTINUE | |
20289 | IF(ISWMDL(11).GE.2) THEN | |
20290 | WRITE(LO,'(/6X,A)') | |
20291 | & 'diagram with / without color re-connection' | |
20292 | DO 320 I=1,8 | |
20293 | WRITE(LO,'(2X,A,2I11)') PROC(I),IRECN(I,1),IRECN(I,2) | |
20294 | 320 CONTINUE | |
20295 | ENDIF | |
20296 | RETURN | |
20297 | ENDIF | |
20298 | C | |
20299 | C gluons: first color positive, quarks second color zero | |
20300 | IF(IP1.EQ.0) THEN | |
20301 | IF(ICA1.LT.0) THEN | |
20302 | I = ICA2 | |
20303 | ICA2 = ICA1 | |
20304 | ICA1 = I | |
20305 | ENDIF | |
20306 | ELSE | |
20307 | ICA2 = 0 | |
20308 | ENDIF | |
20309 | IF(IP2.EQ.0) THEN | |
20310 | IF(ICB1.LT.0) THEN | |
20311 | I = ICB2 | |
20312 | ICB2 = ICB1 | |
20313 | ICB1 = I | |
20314 | ENDIF | |
20315 | ELSE | |
20316 | ICB2 = 0 | |
20317 | ENDIF | |
20318 | IC2 = 0 | |
20319 | IC4 = 0 | |
20320 | C debug output | |
20321 | IF(IDEB(26).GE.15) | |
20322 | & WRITE(LO,'(1X,A,I4,/,5X,A,3I5,2X,3I5)') | |
20323 | & 'PHO_HARCOL: process',MSPR, | |
20324 | & 'initial partons and colors',IP1,ICA1,ICA2,IP2,ICB1,ICB2 | |
20325 | C | |
20326 | IRC = 0 | |
20327 | IF(IPAMDL(21).EQ.1) THEN | |
20328 | C | |
20329 | C soft color re-connection option | |
20330 | C | |
20331 | IF(MSPR.EQ.1) THEN | |
20332 | C hard g g final state, only g g --> g g | |
20333 | IF((ICA1.NE.-ICA2).AND.(ICB1.NE.-ICB2)) THEN | |
20334 | IF(DT_RNDM(V).LT.PARMDL(140)) THEN | |
20335 | IC1 = ICA1 | |
20336 | IC2 = ICA2 | |
20337 | IC3 = ICB1 | |
20338 | IC4 = ICB2 | |
20339 | IRECN(MSPR,1) = IRECN(MSPR,1)+1 | |
20340 | IRC = 1 | |
20341 | GOTO 100 | |
20342 | ENDIF | |
20343 | ENDIF | |
20344 | ELSE IF(MSPR.EQ.3) THEN | |
20345 | C hard q g final state | |
20346 | IF((ICA1.NE.-ICA2).AND.(ICB1.NE.-ICB2)) THEN | |
20347 | IF(DT_RNDM(V).LT.PARMDL(141)) THEN | |
20348 | IC1 = ICA1 | |
20349 | IC2 = ICA2 | |
20350 | IC3 = ICB1 | |
20351 | IC4 = ICB2 | |
20352 | IRECN(MSPR,1) = IRECN(MSPR,1)+1 | |
20353 | IRC = 1 | |
20354 | GOTO 100 | |
20355 | ENDIF | |
20356 | ENDIF | |
20357 | ELSE IF((MSPR.EQ.5).OR.(MSPR.EQ.7).OR.(MSPR.EQ.8)) THEN | |
20358 | C hard q q final state | |
20359 | IF(ICA1.NE.-ICB1) THEN | |
20360 | IF(DT_RNDM(V).LT.PARMDL(142)) THEN | |
20361 | IC1 = ICA1 | |
20362 | IC2 = ICA2 | |
20363 | IC3 = ICB1 | |
20364 | IC4 = ICB2 | |
20365 | IRECN(MSPR,1) = IRECN(MSPR,1)+1 | |
20366 | IRC = 1 | |
20367 | GOTO 100 | |
20368 | ENDIF | |
20369 | ENDIF | |
20370 | ENDIF | |
20371 | IRECN(MSPR,2) = IRECN(MSPR,2)+1 | |
20372 | ENDIF | |
20373 | C | |
20374 | IF((ISWMDL(11).EQ.1).AND.(MSPR.LT.10)) THEN | |
20375 | C | |
20376 | C large Nc limit of all graphs | |
20377 | C | |
20378 | IF(MSPR.EQ.1) THEN | |
20379 | C g g --> g g | |
20380 | IF(DT_RNDM(V).GT.0.5D0) THEN | |
20381 | IC1 = ICB1 | |
20382 | IC2 = ICA2 | |
20383 | IC3 = ICA1 | |
20384 | IC4 = ICB2 | |
20385 | ICONF(MSPR,1) = ICONF(MSPR,1)+1 | |
20386 | ELSE | |
20387 | IC1 = ICA1 | |
20388 | IC2 = ICB2 | |
20389 | IC3 = ICB1 | |
20390 | IC4 = ICA2 | |
20391 | ICONF(MSPR,2) = ICONF(MSPR,2)+1 | |
20392 | ENDIF | |
20393 | ELSE IF(MSPR.EQ.2) THEN | |
20394 | C q qb --> g g | |
20395 | CALL PHO_SELCOL(0,0,I1,K1,I2,K2,1) | |
20396 | IF(ICA1.LT.0) THEN | |
20397 | IC1 = I1 | |
20398 | IC2 = ICA1 | |
20399 | IC3 = ICB1 | |
20400 | IC4 = I2 | |
20401 | ICONF(MSPR,2) = ICONF(MSPR,2)+1 | |
20402 | ELSE | |
20403 | IC1 = ICA1 | |
20404 | IC2 = I2 | |
20405 | IC3 = I1 | |
20406 | IC4 = ICB1 | |
20407 | ICONF(MSPR,1) = ICONF(MSPR,1)+1 | |
20408 | ENDIF | |
20409 | ELSE IF(MSPR.EQ.3) THEN | |
20410 | C q g --> q g | |
20411 | IF(DT_RNDM(V).LT.0.5D0) THEN | |
20412 | IF(IP1+IP2.GT.0) THEN | |
20413 | IC1 = ICB1 | |
20414 | IC2 = ICA2 | |
20415 | IC3 = ICA1 | |
20416 | IC4 = ICB2 | |
20417 | ELSE IF(IP1.LT.0) THEN | |
20418 | IC1 = ICB2 | |
20419 | IC3 = ICB1 | |
20420 | IC4 = ICA1 | |
20421 | ELSE | |
20422 | IC1 = ICA1 | |
20423 | IC2 = ICB1 | |
20424 | IC3 = ICA2 | |
20425 | ENDIF | |
20426 | ICONF(MSPR,1) = ICONF(MSPR,1)+1 | |
20427 | ELSE | |
20428 | IF(IP1.GT.0) THEN | |
20429 | CALL PHO_HARCOR(-ICA1,ICB2) | |
20430 | IC1 = ICA1 | |
20431 | IC3 = ICB1 | |
20432 | IC4 = -ICA1 | |
20433 | ELSE IF(IP2.GT.0) THEN | |
20434 | CALL PHO_HARCOR(-ICB1,ICA2) | |
20435 | IC1 = ICA1 | |
20436 | IC2 = -ICB1 | |
20437 | IC3 = ICB1 | |
20438 | ELSE IF(IP1.LT.0) THEN | |
20439 | CALL PHO_HARCOR(-ICA1,ICB1) | |
20440 | IC1 = ICA1 | |
20441 | IC3 = -ICA1 | |
20442 | IC4 = ICB2 | |
20443 | ELSE IF(IP2.LT.0) THEN | |
20444 | CALL PHO_HARCOR(-ICB1,ICA1) | |
20445 | IC1 = -ICB1 | |
20446 | IC2 = ICA2 | |
20447 | IC3 = ICB1 | |
20448 | ENDIF | |
20449 | ICONF(MSPR,2) = ICONF(MSPR,2)+1 | |
20450 | ENDIF | |
20451 | ELSE IF(MSPR.EQ.4) THEN | |
20452 | C g g --> q qb | |
20453 | IC1 = ICA1 | |
20454 | IC3 = ICB2 | |
20455 | CALL PHO_HARCOR(-ICB1,ICA2) | |
20456 | IF(ICB2.EQ.-ICB1) IC3 = ICA2 | |
20457 | IF(IP3*IC1.LT.0) THEN | |
20458 | I = IC1 | |
20459 | IC1 = IC3 | |
20460 | IC3 = I | |
20461 | ENDIF | |
20462 | ICONF(MSPR,2) = ICONF(MSPR,2)+1 | |
20463 | ELSE IF(MSPR.EQ.5) THEN | |
20464 | C q qb --> q qb | |
20465 | IF(DT_RNDM(V).LT.0.5D0) THEN | |
20466 | IF(ICA1*IP3.LT.0) THEN | |
20467 | IC1 = ICB1 | |
20468 | IC3 = ICA1 | |
20469 | ELSE | |
20470 | IC1 = ICA1 | |
20471 | IC3 = ICB1 | |
20472 | ENDIF | |
20473 | ICONF(MSPR,1) = ICONF(MSPR,1)+1 | |
20474 | ELSE | |
20475 | IF(ICA1*IP3.LT.0) THEN | |
20476 | IC1 = -ICA1 | |
20477 | IC3 = ICA1 | |
20478 | ELSE | |
20479 | IC1 = ICA1 | |
20480 | IC3 = -ICA1 | |
20481 | ENDIF | |
20482 | CALL PHO_HARCOR(-ICA1,ICB1) | |
20483 | ICONF(MSPR,2) = ICONF(MSPR,2)+1 | |
20484 | ENDIF | |
20485 | ELSE IF(MSPR.EQ.6) THEN | |
20486 | C q qb --> qp qbp | |
20487 | IF(ICA1*IP3.LT.0) THEN | |
20488 | IC1 = ICB1 | |
20489 | IC3 = ICA1 | |
20490 | ICONF(MSPR,1) = ICONF(MSPR,1)+1 | |
20491 | ELSE | |
20492 | IC1 = ICA1 | |
20493 | IC3 = ICB1 | |
20494 | ICONF(MSPR,2) = ICONF(MSPR,2)+1 | |
20495 | ENDIF | |
20496 | ELSE IF(MSPR.EQ.7) THEN | |
20497 | C q q --> q q | |
20498 | IF(DT_RNDM(V).LT.0.5D0) THEN | |
20499 | IC1 = ICA1 | |
20500 | IC3 = ICB1 | |
20501 | ICONF(MSPR,1) = ICONF(MSPR,1)+1 | |
20502 | ELSE | |
20503 | IC1 = ICB1 | |
20504 | IC3 = ICA1 | |
20505 | ICONF(MSPR,2) = ICONF(MSPR,2)+1 | |
20506 | ENDIF | |
20507 | ELSE IF(MSPR.EQ.8) THEN | |
20508 | C q qp --> q qp | |
20509 | IF(IP1*IP2.GT.0) THEN | |
20510 | IF(IP3.EQ.IP1) THEN | |
20511 | IC1 = ICB1 | |
20512 | IC3 = ICA1 | |
20513 | ELSE | |
20514 | IC1 = ICA1 | |
20515 | IC3 = ICB1 | |
20516 | ENDIF | |
20517 | ICONF(MSPR,1) = ICONF(MSPR,1)+1 | |
20518 | ELSE | |
20519 | IF(ICA1*IP3.LT.0) THEN | |
20520 | IC1 = -ICA1 | |
20521 | IC3 = ICA1 | |
20522 | ELSE | |
20523 | IC1 = ICA1 | |
20524 | IC3 = -ICA1 | |
20525 | ENDIF | |
20526 | CALL PHO_HARCOR(-ICA1,ICB1) | |
20527 | ICONF(MSPR,2) = ICONF(MSPR,2)+1 | |
20528 | ENDIF | |
20529 | ELSE | |
20530 | C unknown process | |
20531 | WRITE(LO,'(/1X,A,I3)') | |
20532 | & 'PHO_HARCOL:ERROR:invalid process number (MSPR)',MSPR | |
20533 | CALL PHO_ABORT | |
20534 | ENDIF | |
20535 | C | |
20536 | ELSE | |
20537 | C | |
20538 | C color flow according to QCD leading order matrix element | |
20539 | C | |
20540 | U = -(1.D0+V) | |
20541 | IF(MSPR.EQ.1) THEN | |
20542 | C g g --> g g | |
20543 | PC(1) = 1/V**2 +2.D0/V +3.D0 +2.D0*V +V**2 | |
20544 | PC(2) = 1/U**2 +2.D0/U +3.D0 +2.D0*U +U**2 | |
20545 | PC(3) = (V/U)**2+2.D0*(V/U)+3.D0 +2.D0*(U/V)+(U/V)**2 | |
20546 | XI = (PC(1)+PC(2)+PC(3))*DT_RNDM(U) | |
20547 | PCS = 0.D0 | |
20548 | DO 110 I=1,3 | |
20549 | PCS = PCS+PC(I) | |
20550 | IF(XI.LT.PCS) GOTO 120 | |
20551 | 110 CONTINUE | |
20552 | 120 CONTINUE | |
20553 | IF(I.EQ.1) THEN | |
20554 | CALL PHO_SELCOL(0,0,I1,K1,I2,K2,1) | |
20555 | IF(DT_RNDM(V).GT.0.5D0) THEN | |
20556 | IC1 = I1 | |
20557 | IC2 = ICA2 | |
20558 | IC3 = ICB1 | |
20559 | IC4 = I2 | |
20560 | CALL PHO_HARCOR(-ICB2,ICA1) | |
20561 | IF(ICB1.EQ.-ICB2) IC3 = ICA1 | |
20562 | ELSE | |
20563 | IC1 = ICA1 | |
20564 | IC2 = I2 | |
20565 | IC3 = I1 | |
20566 | IC4 = ICB2 | |
20567 | CALL PHO_HARCOR(-ICB1,ICA2) | |
20568 | IF(ICB2.EQ.-ICB1) IC4 = ICA2 | |
20569 | ENDIF | |
20570 | ELSE IF(I.EQ.2) THEN | |
20571 | CALL PHO_SELCOL(0,0,I1,K1,I2,K2,1) | |
20572 | IF(DT_RNDM(U).GT.0.5D0) THEN | |
20573 | IC1 = ICB1 | |
20574 | IC2 = I2 | |
20575 | IC3 = I1 | |
20576 | IC4 = ICA2 | |
20577 | CALL PHO_HARCOR(-ICB2,ICA1) | |
20578 | IF(ICB1.EQ.-ICB2) IC1 = ICA1 | |
20579 | ELSE | |
20580 | IC1 = I1 | |
20581 | IC2 = ICB2 | |
20582 | IC3 = ICA1 | |
20583 | IC4 = I2 | |
20584 | CALL PHO_HARCOR(-ICB1,ICA2) | |
20585 | IF(ICB2.EQ.-ICB1) IC2 = ICA2 | |
20586 | ENDIF | |
20587 | ELSE | |
20588 | IF(DT_RNDM(V).GT.0.5D0) THEN | |
20589 | IC1 = ICB1 | |
20590 | IC2 = ICA2 | |
20591 | IC3 = ICA1 | |
20592 | IC4 = ICB2 | |
20593 | ELSE | |
20594 | IC1 = ICA1 | |
20595 | IC2 = ICB2 | |
20596 | IC3 = ICB1 | |
20597 | IC4 = ICA2 | |
20598 | ENDIF | |
20599 | ENDIF | |
20600 | ICONF(MSPR,I) = ICONF(MSPR,I)+1 | |
20601 | ELSE IF(MSPR.EQ.2) THEN | |
20602 | C q qb --> g g | |
20603 | PC(1) = U/V-2.D0*U**2 | |
20604 | PC(2) = V/U-2.D0*V**2 | |
20605 | CALL PHO_SELCOL(0,0,I1,K1,I2,K2,1) | |
20606 | XI = (PC(1)+PC(2))*DT_RNDM(U) | |
20607 | IF(XI.LT.PC(1)) THEN | |
20608 | IF(ICA1.GT.0) THEN | |
20609 | IC1 = ICA1 | |
20610 | IC2 = I2 | |
20611 | IC3 = I1 | |
20612 | IC4 = ICB1 | |
20613 | ICONF(MSPR,1) = ICONF(MSPR,1)+1 | |
20614 | ELSE | |
20615 | IC1 = I1 | |
20616 | IC2 = ICA1 | |
20617 | IC3 = ICB1 | |
20618 | IC4 = I2 | |
20619 | ICONF(MSPR,2) = ICONF(MSPR,2)+1 | |
20620 | ENDIF | |
20621 | ELSE | |
20622 | IF(ICA1.GT.0) THEN | |
20623 | IC1 = I1 | |
20624 | IC2 = ICB1 | |
20625 | IC3 = ICA1 | |
20626 | IC4 = I2 | |
20627 | ICONF(MSPR,3) = ICONF(MSPR,3)+1 | |
20628 | ELSE | |
20629 | IC1 = ICB1 | |
20630 | IC2 = I2 | |
20631 | IC3 = I1 | |
20632 | IC4 = ICA1 | |
20633 | ICONF(MSPR,4) = ICONF(MSPR,4)+1 | |
20634 | ENDIF | |
20635 | ENDIF | |
20636 | ELSE IF(MSPR.EQ.3) THEN | |
20637 | C q g --> q g | |
20638 | PC(1) = 2.D0*(U/V)**2-U | |
20639 | PC(2) = 2.D0/V**2-1.D0/U | |
20640 | XI = (PC(1)+PC(2))*DT_RNDM(V) | |
20641 | IF(XI.LT.PC(1)) THEN | |
20642 | CALL PHO_SELCOL(0,0,I1,K1,I2,K2,1) | |
20643 | IF(IP1.GT.0) THEN | |
20644 | IC1 = I1 | |
20645 | IC3 = ICB1 | |
20646 | IC4 = I2 | |
20647 | CALL PHO_HARCOR(-ICA1,ICB2) | |
20648 | ICONF(MSPR,1) = ICONF(MSPR,1)+1 | |
20649 | ELSE IF(IP1.LT.0) THEN | |
20650 | IC1 = I2 | |
20651 | IC3 = I1 | |
20652 | IC4 = ICB2 | |
20653 | CALL PHO_HARCOR(-ICA1,ICB1) | |
20654 | ICONF(MSPR,1) = ICONF(MSPR,1)+1 | |
20655 | ELSE IF(IP2.GT.0) THEN | |
20656 | IC1 = ICA1 | |
20657 | IC2 = I2 | |
20658 | IC3 = I1 | |
20659 | CALL PHO_HARCOR(-ICB1,ICA2) | |
20660 | ICONF(MSPR,2) = ICONF(MSPR,2)+1 | |
20661 | ELSE | |
20662 | IC1 = I1 | |
20663 | IC2 = ICA2 | |
20664 | IC3 = I2 | |
20665 | CALL PHO_HARCOR(-ICB1,ICA1) | |
20666 | ICONF(MSPR,2) = ICONF(MSPR,2)+1 | |
20667 | ENDIF | |
20668 | ELSE | |
20669 | IF(IP1.GT.0) THEN | |
20670 | IC1 = ICB1 | |
20671 | IC3 = ICA1 | |
20672 | IC4 = ICB2 | |
20673 | ICONF(MSPR,3) = ICONF(MSPR,3)+1 | |
20674 | ELSE IF(IP1.LT.0) THEN | |
20675 | IC1 = ICB2 | |
20676 | IC3 = ICB1 | |
20677 | IC4 = ICA1 | |
20678 | ICONF(MSPR,3) = ICONF(MSPR,3)+1 | |
20679 | ELSE IF(IP2.GT.0) THEN | |
20680 | IC1 = ICB1 | |
20681 | IC2 = ICA2 | |
20682 | IC3 = ICA1 | |
20683 | ICONF(MSPR,4) = ICONF(MSPR,4)+1 | |
20684 | ELSE | |
20685 | IC1 = ICA1 | |
20686 | IC2 = ICB1 | |
20687 | IC3 = ICA2 | |
20688 | ICONF(MSPR,4) = ICONF(MSPR,4)+1 | |
20689 | ENDIF | |
20690 | ENDIF | |
20691 | ELSE IF(MSPR.EQ.4) THEN | |
20692 | C g g --> q qb | |
20693 | PC(1) = U/V-2.D0*U**2 | |
20694 | PC(2) = V/U-2.D0*V**2 | |
20695 | XI = (PC(1)+PC(2))*DT_RNDM(U) | |
20696 | IF(XI.LT.PC(1)) THEN | |
20697 | IF(IP3.GT.0) THEN | |
20698 | IC1 = ICA1 | |
20699 | IC3 = ICB2 | |
20700 | CALL PHO_HARCOR(-ICB1,ICA2) | |
20701 | IF(ICB2.EQ.-ICB1) IC3 = ICA2 | |
20702 | ICONF(MSPR,1) = ICONF(MSPR,1)+1 | |
20703 | ELSE | |
20704 | IC1 = ICA2 | |
20705 | IC3 = ICB1 | |
20706 | CALL PHO_HARCOR(-ICB2,ICA1) | |
20707 | IF(ICB1.EQ.-ICB2) IC3 = ICA1 | |
20708 | ICONF(MSPR,2) = ICONF(MSPR,2)+1 | |
20709 | ENDIF | |
20710 | ELSE | |
20711 | IF(IP3.GT.0) THEN | |
20712 | IC1 = ICB1 | |
20713 | IC3 = ICA2 | |
20714 | CALL PHO_HARCOR(-ICB2,ICA1) | |
20715 | IF(ICB1.EQ.-ICB2) IC1 = ICA1 | |
20716 | ICONF(MSPR,3) = ICONF(MSPR,3)+1 | |
20717 | ELSE | |
20718 | IC1 = ICB2 | |
20719 | IC3 = ICA1 | |
20720 | CALL PHO_HARCOR(-ICB1,ICA2) | |
20721 | IF(ICB2.EQ.-ICB1) IC1 = ICA2 | |
20722 | ICONF(MSPR,4) = ICONF(MSPR,4)+1 | |
20723 | ENDIF | |
20724 | ENDIF | |
20725 | ELSE IF(MSPR.EQ.5) THEN | |
20726 | C q qb --> q qb | |
20727 | PC(1) = (1.D0+U**2)/V**2 | |
20728 | PC(2) = (V**2+U**2) | |
20729 | XI = (PC(1)+PC(2))*DT_RNDM(V) | |
20730 | IF(XI.LT.PC(1)) THEN | |
20731 | CALL PHO_HARCOR(-ICB1,ICA1) | |
20732 | CALL PHO_SELCOL(0,0,I1,K1,I2,K2,1) | |
20733 | IF(IP3.GT.0) THEN | |
20734 | IC1 = I1 | |
20735 | IC3 = I2 | |
20736 | ICONF(MSPR,1) = ICONF(MSPR,1)+1 | |
20737 | ELSE | |
20738 | IC1 = I2 | |
20739 | IC3 = I1 | |
20740 | ICONF(MSPR,2) = ICONF(MSPR,2)+1 | |
20741 | ENDIF | |
20742 | ELSE | |
20743 | IF(IP3.GT.0) THEN | |
20744 | IC1 = MAX(ICA1,ICB1) | |
20745 | IC3 = MIN(ICA1,ICB1) | |
20746 | ICONF(MSPR,3) = ICONF(MSPR,3)+1 | |
20747 | ELSE | |
20748 | IC1 = MIN(ICA1,ICB1) | |
20749 | IC3 = MAX(ICA1,ICB1) | |
20750 | ICONF(MSPR,4) = ICONF(MSPR,4)+1 | |
20751 | ENDIF | |
20752 | ENDIF | |
20753 | ELSE IF(MSPR.EQ.6) THEN | |
20754 | C q qb --> qp qpb | |
20755 | IF(IP3.GT.0) THEN | |
20756 | IC1 = MAX(ICA1,ICB1) | |
20757 | IC3 = MIN(ICA1,ICB1) | |
20758 | ICONF(MSPR,1) = ICONF(MSPR,1)+1 | |
20759 | ELSE | |
20760 | IC1 = MIN(ICA1,ICB1) | |
20761 | IC3 = MAX(ICA1,ICB1) | |
20762 | ICONF(MSPR,2) = ICONF(MSPR,2)+1 | |
20763 | ENDIF | |
20764 | ELSE IF(MSPR.EQ.7) THEN | |
20765 | C q q --> q q | |
20766 | PC(1) = (1.D0+U**2)/V**2 | |
20767 | PC(2) = (1.D0+V**2)/U**2 | |
20768 | XI = (PC(1)+PC(2))*DT_RNDM(U) | |
20769 | IF(XI.LT.PC(1)) THEN | |
20770 | IC1 = ICB1 | |
20771 | IC3 = ICA1 | |
20772 | ICONF(MSPR,1) = ICONF(MSPR,1)+1 | |
20773 | ELSE | |
20774 | IC1 = ICA1 | |
20775 | IC3 = ICB1 | |
20776 | ICONF(MSPR,2) = ICONF(MSPR,2)+1 | |
20777 | ENDIF | |
20778 | ELSE IF(MSPR.EQ.8) THEN | |
20779 | C q qp --> q qp | |
20780 | IF(IP1*IP2.LT.0) THEN | |
20781 | CALL PHO_HARCOR(-ICB1,ICA1) | |
20782 | CALL PHO_SELCOL(0,0,I1,K1,I2,K2,1) | |
20783 | IF(IP1.GT.0) THEN | |
20784 | IC1 = I1 | |
20785 | IC3 = I2 | |
20786 | ICONF(MSPR,1) = ICONF(MSPR,1)+1 | |
20787 | ELSE | |
20788 | IC1 = I2 | |
20789 | IC3 = I1 | |
20790 | ICONF(MSPR,2) = ICONF(MSPR,2)+1 | |
20791 | ENDIF | |
20792 | ELSE | |
20793 | IC1 = ICB1 | |
20794 | IC3 = ICA1 | |
20795 | ICONF(MSPR,3) = ICONF(MSPR,3)+1 | |
20796 | ENDIF | |
20797 | ||
20798 | ELSE IF(MSPR.EQ.10) THEN | |
20799 | C gam q --> q g | |
20800 | CALL PHO_SELCOL(ICB1,ICB2,IC1,IC2,IC3,IC4,2) | |
20801 | IF(IP3.EQ.0) THEN | |
20802 | CALL PHO_SWAPI(IC1,IC3) | |
20803 | CALL PHO_SWAPI(IC2,IC4) | |
20804 | ENDIF | |
20805 | ELSE IF(MSPR.EQ.11) THEN | |
20806 | C gam g --> q q | |
20807 | IC1 = ICB1 | |
20808 | IC3 = ICB2 | |
20809 | IF(IP3.LT.0) CALL PHO_SWAPI(IC1,IC3) | |
20810 | ELSE IF(MSPR.EQ.12) THEN | |
20811 | C q gam --> q g | |
20812 | CALL PHO_SELCOL(ICA1,ICA2,IC1,IC2,IC3,IC4,2) | |
20813 | IF(IP3.EQ.0) THEN | |
20814 | CALL PHO_SWAPI(IC1,IC3) | |
20815 | CALL PHO_SWAPI(IC2,IC4) | |
20816 | ENDIF | |
20817 | ELSE IF(MSPR.EQ.13) THEN | |
20818 | C g gam --> q q | |
20819 | IC1 = ICA1 | |
20820 | IC3 = ICA2 | |
20821 | IF(IP3.LT.0) CALL PHO_SWAPI(IC1,IC3) | |
20822 | ELSE IF(MSPR.EQ.14) THEN | |
20823 | IF(ABS(IP3).GT.12) THEN | |
20824 | IC1 = 0 | |
20825 | IC3 = 0 | |
20826 | ELSE | |
20827 | CALL PHO_SELCOL(ICA1,ICA2,IC1,IC2,IC3,IC4,1) | |
20828 | IF(IP3.LT.0) CALL PHO_SWAPI(IC1,IC3) | |
20829 | ENDIF | |
20830 | ELSE | |
20831 | C unknown process | |
20832 | WRITE(LO,'(/1X,A,I3)') | |
20833 | & 'PHO_HARCOL:ERROR:invalid process number',MSPR | |
20834 | CALL PHO_ABORT | |
20835 | ENDIF | |
20836 | ENDIF | |
20837 | C | |
20838 | 100 CONTINUE | |
20839 | C debug output | |
20840 | IF(IDEB(26).GE.10) WRITE(LO,'(5X,A,3I5,2X,3I5)') | |
20841 | & 'final partons and colors',IP3,IC1,IC2,IP4,IC3,IC4 | |
20842 | C color connection? | |
20843 | * IF(((IC1.NE.-IC3).AND.(IC1.NE.-IC4)).AND. | |
20844 | * & (((IC2.NE.0).AND.(IC2.NE.-IC3).AND.(IC2.NE.-IC4)) | |
20845 | * & .OR.(IC2.EQ.0))) THEN | |
20846 | C color exchange? | |
20847 | * IF(((IP1.EQ.IP3).AND.(ICA1.EQ.IC1).AND.(ICA2.EQ.IC2)) | |
20848 | * & .OR.((IP1.EQ.IP4).AND.(ICA1.EQ.IC3).AND.(ICA2.EQ.IC4))) THEN | |
20849 | * IF(IRC.NE.1) THEN | |
20850 | * WRITE(LO,'(1X,A,I10,I3)') | |
20851 | * & 'PHO_HARCOL:unexp. re-connection (event/MSPR):',KEVENT,MSPR | |
20852 | * WRITE(LO,'(5X,A,3I5,2X,3I5)') | |
20853 | * & 'initial partons and colors',IP1,ICA1,ICA2,IP2,ICB1,ICB2 | |
20854 | * WRITE(LO,'(5X,A,3I5,2X,3I5)') | |
20855 | * & 'final partons and colors ',IP3,IC1,IC2,IP4,IC3,IC4 | |
20856 | * ENDIF | |
20857 | * IRC = 0 | |
20858 | * ENDIF | |
20859 | * ENDIF | |
20860 | * IF(IRC.EQ.1) THEN | |
20861 | * WRITE(LO,'(1X,A,I10,I3)') | |
20862 | * & 'PHO_HARCOL:re-conn. failed (event/MSPR):',KEVENT,MSPR | |
20863 | * WRITE(LO,'(5X,A,3I5,2X,3I5)') | |
20864 | * & 'initial partons and colors',IP1,ICA1,ICA2,IP2,ICB1,ICB2 | |
20865 | * WRITE(LO,'(5X,A,3I5,2X,3I5)') | |
20866 | * & 'final partons and colors ',IP3,IC1,IC2,IP4,IC3,IC4 | |
20867 | * ENDIF | |
20868 | C | |
20869 | ICC1 = IC1 | |
20870 | ICC2 = IC2 | |
20871 | ICD1 = IC3 | |
20872 | ICD2 = IC4 | |
20873 | ||
20874 | END | |
20875 | ||
20876 | *$ CREATE PHO_HARCOR.FOR | |
20877 | *COPY PHO_HARCOR | |
20878 | CDECK ID>, PHO_HARCOR | |
20879 | SUBROUTINE PHO_HARCOR(ICOLD,ICNEW) | |
20880 | C*********************************************************************** | |
20881 | C | |
20882 | C substituite color in /POEVT2/ | |
20883 | C | |
20884 | C input: ICOLD old color | |
20885 | C ICNEW new color | |
20886 | C | |
20887 | C*********************************************************************** | |
20888 | IMPLICIT DOUBLE PRECISION (A-H,O-Z) | |
20889 | SAVE | |
20890 | ||
20891 | C input/output channels | |
20892 | INTEGER LI,LO | |
20893 | COMMON /POINOU/ LI,LO | |
20894 | C standard particle data interface | |
20895 | INTEGER NMXHEP | |
20896 | PARAMETER (NMXHEP=4000) | |
20897 | INTEGER NEVHEP,NHEP,ISTHEP,IDHEP,JMOHEP,JDAHEP | |
20898 | DOUBLE PRECISION PHEP,VHEP | |
20899 | COMMON /POEVT1/ NEVHEP,NHEP,ISTHEP(NMXHEP),IDHEP(NMXHEP), | |
20900 | & JMOHEP(2,NMXHEP),JDAHEP(2,NMXHEP),PHEP(5,NMXHEP), | |
20901 | & VHEP(4,NMXHEP) | |
20902 | C extension to standard particle data interface (PHOJET specific) | |
20903 | INTEGER IMPART,IPHIST,ICOLOR | |
20904 | COMMON /POEVT2/ IMPART(NMXHEP),IPHIST(2,NMXHEP),ICOLOR(2,NMXHEP) | |
20905 | ||
20906 | DO 100 I=NHEP,3,-1 | |
20907 | IF(ISTHEP(I).EQ.-1) THEN | |
20908 | IF(ICOLOR(1,I).EQ.ICOLD) THEN | |
20909 | ICOLOR(1,I) = ICNEW | |
20910 | RETURN | |
20911 | ELSE IF(IDHEP(I).EQ.21) THEN | |
20912 | IF(ICOLOR(2,I).EQ.ICOLD) THEN | |
20913 | ICOLOR(2,I) = ICNEW | |
20914 | RETURN | |
20915 | ENDIF | |
20916 | ENDIF | |
20917 | * ELSE IF(ISTHEP(I).EQ.20) THEN | |
20918 | * IF(ICOLOR(1,I).EQ.-ICOLD) THEN | |
ecf67adb | 20919 | * WRITE(LO,*) ' PHO_HARCOR(3): line, old, new:',I,ICOLD,ICNEW |
9aaba0d6 | 20920 | * ICOLOR(1,I) = -ICNEW |
20921 | * RETURN | |
20922 | * ELSE IF(IDHEP(I).EQ.21) THEN | |
20923 | * IF(ICOLOR(2,I).EQ.-ICOLD) THEN | |
ecf67adb | 20924 | * WRITE(LO,*) ' PHO_HARCOR(4): line, old, new:',I,ICOLD,ICNEW |
9aaba0d6 | 20925 | * ICOLOR(2,I) = -ICNEW |
20926 | * RETURN | |
20927 | * ENDIF | |
20928 | * ENDIF | |
20929 | ENDIF | |
20930 | 100 CONTINUE | |
20931 | END | |
20932 | ||
20933 | *$ CREATE PHO_HARREM.FOR | |
20934 | *COPY PHO_HARREM | |
20935 | CDECK ID>, PHO_HARREM | |
20936 | SUBROUTINE PHO_HARREM(JM1,JM2,IGEN,IHPOS,IVAL,INDXS,IC1,IC2, | |
20937 | & IUSED,IREJ) | |
20938 | C*********************************************************************** | |
20939 | C | |
20940 | C sample color structure for initial quark/gluon of hard scattering | |
20941 | C and write hadron remnant to /POEVT1/ | |
20942 | C | |
20943 | C input: JM1,2 index of mother particle in POEVT1 | |
20944 | C IGEN mother particle production process | |
20945 | C IHPOS hard pomeron number | |
20946 | C INDXH index of hard parton | |
20947 | C positive for labels 1 | |
20948 | C negative for labels 2 | |
20949 | C IVAL 1 hard valence parton | |
20950 | C 0 hard sea parton connected by color flow with | |
20951 | C valence quarks | |
20952 | C -1 hard sea parton independent off valence | |
20953 | C quarks | |
20954 | C INDXS index of soft partons needed | |
20955 | C | |
20956 | C output: IC1,IC2 color label of initial parton | |
20957 | C IUSED number of soft X values used | |
20958 | C IREJ rejection flag | |
20959 | C | |
20960 | C********************************************************************** | |
20961 | IMPLICIT DOUBLE PRECISION (A-H,O-Z) | |
20962 | SAVE | |
20963 | ||
20964 | PARAMETER ( TINY = 1.D-10 ) | |
20965 | ||
20966 | C input/output channels | |
20967 | INTEGER LI,LO | |
20968 | COMMON /POINOU/ LI,LO | |
20969 | C event debugging information | |
20970 | INTEGER NMAXD | |
20971 | PARAMETER (NMAXD=100) | |
20972 | INTEGER IDEB,KSPOM,KHPOM,KSREG,KHDIR,KACCEP,KSTRG,KHTRG,KSLOO, | |
20973 | & KHLOO,KSDPO,KHDPO,KEVENT,KSOFT,KHARD | |
20974 | COMMON /PODEBG/ IDEB(NMAXD),KSPOM,KHPOM,KSREG,KHDIR,KACCEP,KSTRG, | |
20975 | & KHTRG,KSLOO,KHLOO,KSDPO,KHDPO,KEVENT,KSOFT,KHARD | |
20976 | C model switches and parameters | |
20977 | CHARACTER*8 MDLNA | |
20978 | INTEGER ISWMDL,IPAMDL | |
20979 | DOUBLE PRECISION PARMDL | |
20980 | COMMON /POMDLS/ MDLNA(50),ISWMDL(50),PARMDL(400),IPAMDL(400) | |
20981 | C data of c.m. system of Pomeron / Reggeon exchange | |
20982 | INTEGER NPOSP,IDPDG1,IDBAM1,IDPDG2,IDBAM2 | |
20983 | DOUBLE PRECISION ECMP,PCMP,PMASSP,PVIRTP,GAMBEP, | |
20984 | & SIDP,CODP,SIFP,COFP | |
20985 | COMMON /POPCMS/ ECMP,PCMP,PMASSP(2),PVIRTP(2),GAMBEP(4), | |
20986 | & SIDP,CODP,SIFP,COFP,NPOSP(2), | |
20987 | & IDPDG1,IDBAM1,IDPDG2,IDBAM2 | |
20988 | C obsolete cut-off information | |
20989 | DOUBLE PRECISION PTCUT,PTANO,FPS,FPH,PSOMIN,XSOMIN | |
20990 | COMMON /POCUT1/ PTCUT(4),PTANO(4),FPS(4),FPH(4),PSOMIN,XSOMIN | |
20991 | C light-cone x fractions and c.m. momenta of soft cut string ends | |
20992 | INTEGER MAXSOF | |
20993 | PARAMETER ( MAXSOF = 50 ) | |
20994 | INTEGER IJSI2,IJSI1 | |
20995 | DOUBLE PRECISION XS1,XS2,PSOFT1,PSOFT2 | |
20996 | COMMON /POSOFT/ XS1(MAXSOF),XS2(MAXSOF), | |
20997 | & PSOFT1(4,MAXSOF),PSOFT2(4,MAXSOF), | |
20998 | & IJSI1(MAXSOF),IJSI2(MAXSOF) | |
20999 | C hard scattering data | |
21000 | INTEGER MSCAHD | |
21001 | PARAMETER ( MSCAHD = 50 ) | |
21002 | INTEGER LSCAHD,LSC1HD,LSIDX, | |
21003 | & NINHD,N0INHD,NIVAL,N0IVAL,NOUTHD,NBRAHD,NPROHD | |
21004 | DOUBLE PRECISION PPH,PTHD,ETAHD,Q2SCA,PDFVA,XHD,VHD,X0HD | |
21005 | COMMON /POHSLT/ LSCAHD,LSC1HD,LSIDX(MSCAHD), | |
21006 | & PPH(8*MSCAHD,2),PTHD(MSCAHD),ETAHD(MSCAHD,2), | |
21007 | & Q2SCA(MSCAHD,2),PDFVA(MSCAHD,2), | |
21008 | & XHD(MSCAHD,2),VHD(MSCAHD),X0HD(MSCAHD,2), | |
21009 | & NINHD(MSCAHD,2),N0INHD(MSCAHD,2), | |
21010 | & NIVAL(MSCAHD,2),N0IVAL(MSCAHD,2), | |
21011 | & NOUTHD(MSCAHD,2),NBRAHD(MSCAHD,2),NPROHD(MSCAHD) | |
21012 | C standard particle data interface | |
21013 | INTEGER NMXHEP | |
21014 | PARAMETER (NMXHEP=4000) | |
21015 | INTEGER NEVHEP,NHEP,ISTHEP,IDHEP,JMOHEP,JDAHEP | |
21016 | DOUBLE PRECISION PHEP,VHEP | |
21017 | COMMON /POEVT1/ NEVHEP,NHEP,ISTHEP(NMXHEP),IDHEP(NMXHEP), | |
21018 | & JMOHEP(2,NMXHEP),JDAHEP(2,NMXHEP),PHEP(5,NMXHEP), | |
21019 | & VHEP(4,NMXHEP) | |
21020 | C extension to standard particle data interface (PHOJET specific) | |
21021 | INTEGER IMPART,IPHIST,ICOLOR | |
21022 | COMMON /POEVT2/ IMPART(NMXHEP),IPHIST(2,NMXHEP),ICOLOR(2,NMXHEP) | |
21023 | C internal rejection counters | |
21024 | INTEGER NMXJ | |
21025 | PARAMETER (NMXJ=60) | |
21026 | CHARACTER*10 REJTIT | |
21027 | INTEGER IFAIL | |
21028 | COMMON /POLOOP/ IFAIL(NMXJ),REJTIT(NMXJ) | |
21029 | ||
21030 | IREJ = 0 | |
21031 | ||
21032 | INDXH = SIGN(LSIDX(ABS(IHPOS)),IHPOS) | |
21033 | ||
21034 | IF(INDXH.GT.0) THEN | |
21035 | IJH = IPHO_CNV1(NINHD(INDXH,1)) | |
21036 | ELSE | |
21037 | IJH = IPHO_CNV1(NINHD(-INDXH,2)) | |
21038 | ENDIF | |
21039 | C direct process (photon or pomeron) | |
21040 | IUSED = 0 | |
21041 | IC1 = 0 | |
21042 | IC2 = 0 | |
21043 | IF((IJH.EQ.22).OR.(IJH.EQ.990)) RETURN | |
21044 | ||
21045 | IHP = 100*ABS(IHPOS) | |
21046 | IVSW = 1 | |
21047 | *************************************** | |
21048 | * IF((IDHEP(JM1).EQ.22).OR.(IDHEP(JM1).EQ.990)) IVSW = 0 | |
21049 | *************************************** | |
21050 | ||
21051 | IF(IDEB(28).GE.20) WRITE(LO,'(1X,A,2I3,1X,5I4)') | |
21052 | & 'PHO_HARREM: JM1,JM2,IHPOS,INDXH,IFLH,IVAL,INDXS:', | |
21053 | & JM1,JM2,IHPOS,INDXH,IJH,IVAL,INDXS | |
21054 | ||
21055 | C quark | |
21056 | C**************************************************************** | |
21057 | ||
21058 | IF(IJH.NE.21) THEN | |
21059 | ||
21060 | C valence quark engaged in hard scattering | |
21061 | IF(IVAL.EQ.1) THEN | |
21062 | CALL PHO_PARREM(JM1,IJH,IREM,IREJ) | |
21063 | IF(IREJ.NE.0) THEN | |
21064 | WRITE(LO,'(/1X,2A,2I6)') 'PHO_HARREM: ', | |
21065 | & 'invalid valence flavour requested JM,IFLA',JM1,IJH | |
21066 | return | |
21067 | ENDIF | |
21068 | CALL PHO_SELCOL(0,0,ICA1,ICA2,ICB1,ICB2,1) | |
21069 | IF(((ABS(IREM).GT.6).AND.(IREM.GT.0)) | |
21070 | & .OR.((ABS(IREM).LE.6).AND.(IREM.LT.0))) THEN | |
21071 | I = ICA1 | |
21072 | ICA1 = ICB1 | |
21073 | ICB1 = I | |
21074 | ENDIF | |
21075 | C remnant of hadron | |
21076 | IF(INDXH.GT.0) THEN | |
21077 | P1 = PSOFT1(1,INDXS) | |
21078 | P2 = PSOFT1(2,INDXS) | |
21079 | P3 = PSOFT1(3,INDXS) | |
21080 | P4 = PSOFT1(4,INDXS) | |
21081 | IJSI1(INDXS) = IREM | |
21082 | ELSE | |
21083 | P1 = PSOFT2(1,INDXS) | |
21084 | P2 = PSOFT2(2,INDXS) | |
21085 | P3 = PSOFT2(3,INDXS) | |
21086 | P4 = PSOFT2(4,INDXS) | |
21087 | IJSI2(INDXS) = IREM | |
21088 | ENDIF | |
21089 | C registration | |
21090 | CALL PHO_REGPAR(-1,IREM,0,JM1,JM2,P1,P2,P3,P4, | |
21091 | & IHP,IGEN,ICA1,IVSW,IPOS,1) | |
21092 | IF(IDEB(28).GE.20) WRITE(LO,'(1X,A,3I5)') | |
21093 | & 'PHO_HARREM: val.spectator:(IFL,IPOS,INDXS)', | |
21094 | & IREM,IPOS,SIGN(INDXS,INDXH) | |
21095 | IUSED = 1 | |
21096 | ||
21097 | C sea quark engaged in hard scattering, valence quarks treated | |
21098 | ELSE IF(IVAL.EQ.0) THEN | |
21099 | IF(INDXH.GT.0) THEN | |
21100 | E1 = PSOFT1(4,INDXS) | |
21101 | E2 = PSOFT1(4,INDXS+1) | |
21102 | ELSE | |
21103 | E1 = PSOFT2(4,INDXS) | |
21104 | E2 = PSOFT2(4,INDXS+1) | |
21105 | ENDIF | |
21106 | CALL PHO_VALFLA(JM1,IVFL1,IVFL2,E1,E2) | |
21107 | CALL PHO_SELCOL(0,0,ICA1,ICA2,ICB1,ICB2,1) | |
21108 | IF(DT_RNDM(P1).LT.0.5D0) THEN | |
21109 | CALL PHO_SELCOL(ICB1,ICB2,ICB1,ICB2,ICC1,ICC2,2) | |
21110 | ELSE | |
21111 | CALL PHO_SELCOL(ICA1,ICA2,ICA1,ICA2,ICC1,ICC2,2) | |
21112 | ENDIF | |
21113 | IF(((ABS(IVFL1).GT.6).AND.(IVFL1.GT.0)) | |
21114 | & .OR.((ABS(IVFL1).LE.6).AND.(IVFL1.LT.0))) THEN | |
21115 | I = ICA1 | |
21116 | ICA1 = ICB1 | |
21117 | ICB1 = I | |
21118 | ENDIF | |
21119 | IF(INDXH.GT.0) THEN | |
21120 | P1 = PSOFT1(1,INDXS) | |
21121 | P2 = PSOFT1(2,INDXS) | |
21122 | P3 = PSOFT1(3,INDXS) | |
21123 | P4 = PSOFT1(4,INDXS) | |
21124 | IJSI1(INDXS) = IVFL1 | |
21125 | ELSE | |
21126 | P1 = PSOFT2(1,INDXS) | |
21127 | P2 = PSOFT2(2,INDXS) | |
21128 | P3 = PSOFT2(3,INDXS) | |
21129 | P4 = PSOFT2(4,INDXS) | |
21130 | IJSI2(INDXS) = IVFL1 | |
21131 | ENDIF | |
21132 | C registration | |
21133 | CALL PHO_REGPAR(-1,IVFL1,0,JM1,JM2,P1,P2,P3,P4, | |
21134 | & IHP,IGEN,ICA1,IVSW,IPOS,1) | |
21135 | IF(IDEB(28).GE.20) WRITE(LO,'(1X,A,3I5)') | |
21136 | & 'PHO_HARREM: val.spectator:(IFL,IPOS,INDXS)', | |
21137 | & IVFL1,IPOS,SIGN(INDXS,INDXH) | |
21138 | C | |
21139 | IF(INDXH.GT.0) THEN | |
21140 | P1 = PSOFT1(1,INDXS+1) | |
21141 | P2 = PSOFT1(2,INDXS+1) | |
21142 | P3 = PSOFT1(3,INDXS+1) | |
21143 | P4 = PSOFT1(4,INDXS+1) | |
21144 | IJSI1(INDXS+1) = IVFL2 | |
21145 | ELSE | |
21146 | P1 = PSOFT2(1,INDXS+1) | |
21147 | P2 = PSOFT2(2,INDXS+1) | |
21148 | P3 = PSOFT2(3,INDXS+1) | |
21149 | P4 = PSOFT2(4,INDXS+1) | |
21150 | IJSI2(INDXS+1) = IVFL2 | |
21151 | ENDIF | |
21152 | C registration | |
21153 | CALL PHO_REGPAR(-1,IVFL2,0,JM1,JM2,P1,P2,P3,P4, | |
21154 | & IHP,IGEN,ICB1,IVSW,IPOS,1) | |
21155 | IF(IDEB(28).GE.20) WRITE(LO,'(1X,A,3I5)') | |
21156 | & 'PHO_HARREM: val.spectator:(IFL,IPOS,INDXS)', | |
21157 | & IVFL2,IPOS,SIGN(INDXS+1,INDXH) | |
21158 | C | |
21159 | IF(IJH.LT.0) THEN | |
21160 | ICB1 = ICC2 | |
21161 | ICA1 = ICC1 | |
21162 | ELSE | |
21163 | ICB1 = ICC1 | |
21164 | ICA1 = ICC2 | |
21165 | ENDIF | |
21166 | IF(INDXH.GT.0) THEN | |
21167 | P1 = PSOFT1(1,INDXS+2) | |
21168 | P2 = PSOFT1(2,INDXS+2) | |
21169 | P3 = PSOFT1(3,INDXS+2) | |
21170 | P4 = PSOFT1(4,INDXS+2) | |
21171 | IJSI1(INDXS+2) = -IJH | |
21172 | ELSE | |
21173 | P1 = PSOFT2(1,INDXS+2) | |
21174 | P2 = PSOFT2(2,INDXS+2) | |
21175 | P3 = PSOFT2(3,INDXS+2) | |
21176 | P4 = PSOFT2(4,INDXS+2) | |
21177 | IJSI2(INDXS+2) = -IJH | |
21178 | ENDIF | |
21179 | C registration | |
21180 | CALL PHO_REGPAR(-1,-IJH,0,JM1,JM2,P1,P2,P3,P4, | |
21181 | & IHP,IGEN,ICA1,0,IPOS,1) | |
21182 | IF(IDEB(28).GE.20) WRITE(LO,'(1X,A,3I5)') | |
21183 | & 'PHO_HARREM: sea spectator:(IFL,IPOS,INDXS)', | |
21184 | & -IJH,IPOS,SIGN(INDXS+2,INDXH) | |
21185 | IUSED = 3 | |
21186 | C | |
21187 | C sea quark engaged in hard scattering, valences treated separately | |
21188 | ELSE IF(IVAL.EQ.-1) THEN | |
21189 | CALL PHO_SELCOL(0,0,ICA1,ICA2,ICB1,ICB2,1) | |
21190 | IF(IJH.GT.0) THEN | |
21191 | ICC1 = ICB1 | |
21192 | ICB1 = ICA1 | |
21193 | ICA1 = ICC1 | |
21194 | ENDIF | |
21195 | IF(INDXH.GT.0) THEN | |
21196 | P1 = PSOFT1(1,INDXS) | |
21197 | P2 = PSOFT1(2,INDXS) | |
21198 | P3 = PSOFT1(3,INDXS) | |
21199 | P4 = PSOFT1(4,INDXS) | |
21200 | IJSI1(INDXS) = -IJH | |
21201 | ELSE | |
21202 | P1 = PSOFT2(1,INDXS) | |
21203 | P2 = PSOFT2(2,INDXS) | |
21204 | P3 = PSOFT2(3,INDXS) | |
21205 | P4 = PSOFT2(4,INDXS) | |
21206 | IJSI2(INDXS) = -IJH | |
21207 | ENDIF | |
21208 | C registration | |
21209 | CALL PHO_REGPAR(-1,-IJH,0,JM1,JM2,P1,P2,P3,P4, | |
21210 | & IHP,IGEN,ICA1,0,IPOS,1) | |
21211 | IF(IDEB(28).GE.20) WRITE(LO,'(1X,A,3I5)') | |
21212 | & 'PHO_HARREM: sea spectator:(IFL,IPOS,INDXS)', | |
21213 | & -IJH,IPOS,SIGN(INDXS,INDXH) | |
21214 | IUSED = 1 | |
21215 | ELSE | |
21216 | WRITE(LO,'(1X,A,2I5)') | |
21217 | & 'PHO_HARREM:ERROR:unsupported combination of IVAL,IJH', | |
21218 | & IVAL,IJH | |
21219 | CALL PHO_ABORT | |
21220 | ENDIF | |
21221 | C | |
21222 | IC1 = ICB1 | |
21223 | IC2 = 0 | |
21224 | C | |
21225 | C gluon | |
21226 | C**************************************************************** | |
21227 | C | |
21228 | C gluon from valence quarks | |
21229 | ELSE | |
21230 | IF(IVAL.EQ.1) THEN | |
21231 | C purely gluonic pomeron remnant | |
21232 | IF((IDHEP(JM1).EQ.990).AND.(IPAMDL(20).GT.0)) THEN | |
21233 | IF(INDXH.GT.0) THEN | |
21234 | P1 = PSOFT1(1,INDXS) + PSOFT1(1,INDXS+1) | |
21235 | P2 = PSOFT1(2,INDXS) + PSOFT1(2,INDXS+1) | |
21236 | P3 = PSOFT1(3,INDXS) + PSOFT1(3,INDXS+1) | |
21237 | P4 = PSOFT1(4,INDXS) + PSOFT1(4,INDXS+1) | |
21238 | IJSI1(INDXS) = 0 | |
21239 | ELSE | |
21240 | P1 = PSOFT2(1,INDXS) + PSOFT2(1,INDXS+1) | |
21241 | P2 = PSOFT2(2,INDXS) + PSOFT2(2,INDXS+1) | |
21242 | P3 = PSOFT2(3,INDXS) + PSOFT2(3,INDXS+1) | |
21243 | P4 = PSOFT2(4,INDXS) + PSOFT2(4,INDXS+1) | |
21244 | IJSI2(INDXS) = 0 | |
21245 | ENDIF | |
21246 | IFL1 = 21 | |
21247 | CALL PHO_SELCOL(0,0,ICA1,ICA2,ICB1,ICB2,1) | |
21248 | IF(DT_RNDM(P2).LT.0.5D0) THEN | |
21249 | CALL PHO_SELCOL(ICA1,ICA2,ICA1,ICA2,ICC1,ICC2,2) | |
21250 | ELSE | |
21251 | CALL PHO_SELCOL(ICB1,ICB2,ICB1,ICB2,ICC1,ICC2,2) | |
21252 | ENDIF | |
21253 | C registration | |
21254 | CALL PHO_REGPAR(-1,IFL1,0,JM1,JM2,P1,P2,P3,P4, | |
21255 | & IHP,IGEN,ICA1,ICB1,IPOS,1) | |
21256 | IF(IDEB(28).GE.20) WRITE(LO,'(1X,A,3I5)') | |
21257 | & 'PHO_HARREM: val.gluon:(IFL,IPOS,INDXS)', | |
21258 | & IFL1,IPOS,SIGN(INDXS,INDXH) | |
21259 | IUSED = 2 | |
21260 | C valence quark remnant | |
21261 | ELSE | |
21262 | IF(INDXH.GT.0) THEN | |
21263 | E1 = PSOFT1(4,INDXS) | |
21264 | E2 = PSOFT1(4,INDXS+1) | |
21265 | ELSE | |
21266 | E1 = PSOFT2(4,INDXS) | |
21267 | E2 = PSOFT2(4,INDXS+1) | |
21268 | ENDIF | |
21269 | CALL PHO_VALFLA(JM1,IFL1,IFL2,E1,E2) | |
21270 | CALL PHO_SELCOL(0,0,ICA1,ICA2,ICB1,ICB2,1) | |
21271 | IF(((ABS(IFL1).LE.6).AND.(IFL1.LT.0)) | |
21272 | & .OR.((ABS(IFL1).GT.6).AND.(IFL1.GT.0))) THEN | |
21273 | I = ICA1 | |
21274 | ICA1 = ICB1 | |
21275 | ICB1 = I | |
21276 | ENDIF | |
21277 | IF(DT_RNDM(P2).LT.0.5D0) THEN | |
21278 | CALL PHO_SELCOL(ICA1,ICA2,ICA1,ICA2,ICC1,ICC2,2) | |
21279 | ELSE | |
21280 | CALL PHO_SELCOL(ICB1,ICB2,ICB1,ICB2,ICC1,ICC2,2) | |
21281 | ENDIF | |
21282 | C remnant of hadron | |
21283 | IF(INDXH.GT.0) THEN | |
21284 | P1 = PSOFT1(1,INDXS) | |
21285 | P2 = PSOFT1(2,INDXS) | |
21286 | P3 = PSOFT1(3,INDXS) | |
21287 | P4 = PSOFT1(4,INDXS) | |
21288 | IJSI1(INDXS) = IFL1 | |
21289 | ELSE | |
21290 | P1 = PSOFT2(1,INDXS) | |
21291 | P2 = PSOFT2(2,INDXS) | |
21292 | P3 = PSOFT2(3,INDXS) | |
21293 | P4 = PSOFT2(4,INDXS) | |
21294 | IJSI2(INDXS) = IFL1 | |
21295 | ENDIF | |
21296 | C registration | |
21297 | CALL PHO_REGPAR(-1,IFL1,0,JM1,JM2,P1,P2,P3,P4, | |
21298 | & IHP,IGEN,ICA1,IVSW,IPOS,1) | |
21299 | IF(IDEB(28).GE.20) WRITE(LO,'(1X,A,3I5)') | |
21300 | & 'PHO_HARREM: val.spectator:(IFL,IPOS,INDXS)', | |
21301 | & IFL1,IPOS,SIGN(INDXS,INDXH) | |
21302 | C | |
21303 | IF(INDXH.GT.0) THEN | |
21304 | P1 = PSOFT1(1,INDXS+1) | |
21305 | P2 = PSOFT1(2,INDXS+1) | |
21306 | P3 = PSOFT1(3,INDXS+1) | |
21307 | P4 = PSOFT1(4,INDXS+1) | |
21308 | IJSI1(INDXS+1) = IFL2 | |
21309 | ELSE | |
21310 | P1 = PSOFT2(1,INDXS+1) | |
21311 | P2 = PSOFT2(2,INDXS+1) | |
21312 | P3 = PSOFT2(3,INDXS+1) | |
21313 | P4 = PSOFT2(4,INDXS+1) | |
21314 | IJSI2(INDXS+1) = IFL2 | |
21315 | ENDIF | |
21316 | C registration | |
21317 | CALL PHO_REGPAR(-1,IFL2,0,JM1,JM2,P1,P2,P3,P4, | |
21318 | & IHP,IGEN,ICB1,IVSW,IPOS,1) | |
21319 | IF(IDEB(28).GE.20) WRITE(LO,'(1X,A,3I5)') | |
21320 | & 'PHO_HARREM: val.spectator:(IFL,IPOS,INDXS)', | |
21321 | & IFL2,IPOS,SIGN(INDXS+1,INDXH) | |
21322 | IUSED = 2 | |
21323 | ENDIF | |
21324 | C | |
21325 | C gluon from sea quarks connected with valence quarks | |
21326 | ELSE IF(IVAL.EQ.0) THEN | |
21327 | IF(INDXH.GT.0) THEN | |
21328 | E1 = PSOFT1(4,INDXS) | |
21329 | E2 = PSOFT1(4,INDXS+1) | |
21330 | ELSE | |
21331 | E1 = PSOFT2(4,INDXS) | |
21332 | E2 = PSOFT2(4,INDXS+1) | |
21333 | ENDIF | |
21334 | CALL PHO_VALFLA(JM1,IFL1,IFL2,E1,E2) | |
21335 | CALL PHO_SELCOL(0,0,ICA1,ICA2,ICB1,ICB2,1) | |
21336 | IF(((ABS(IFL1).LE.6).AND.(IFL1.LT.0)) | |
21337 | & .OR.((ABS(IFL1).GT.6).AND.(IFL1.GT.0))) THEN | |
21338 | I = ICA1 | |
21339 | ICA1 = ICB1 | |
21340 | ICB1 = I | |
21341 | ENDIF | |
21342 | IF(DT_RNDM(P3).LT.0.5D0) THEN | |
21343 | CALL PHO_SELCOL(ICA1,ICA2,ICA1,ICA2,ICC1,ICC2,2) | |
21344 | ELSE | |
21345 | CALL PHO_SELCOL(ICB1,ICB2,ICB1,ICB2,ICC1,ICC2,2) | |
21346 | ENDIF | |
21347 | C remnant of hadron | |
21348 | IF(INDXH.GT.0) THEN | |
21349 | P1 = PSOFT1(1,INDXS) | |
21350 | P2 = PSOFT1(2,INDXS) | |
21351 | P3 = PSOFT1(3,INDXS) | |
21352 | P4 = PSOFT1(4,INDXS) | |
21353 | IJSI1(INDXS) = IFL1 | |
21354 | ELSE | |
21355 | P1 = PSOFT2(1,INDXS) | |
21356 | P2 = PSOFT2(2,INDXS) | |
21357 | P3 = PSOFT2(3,INDXS) | |
21358 | P4 = PSOFT2(4,INDXS) | |
21359 | IJSI2(INDXS) = IFL1 | |
21360 | ENDIF | |
21361 | C registration | |
21362 | CALL PHO_REGPAR(-1,IFL1,0,JM1,JM2,P1,P2,P3,P4, | |
21363 | & IHP,IGEN,ICA1,IVSW,IPOS,1) | |
21364 | IF(IDEB(28).GE.20) WRITE(LO,'(1X,A,3I5)') | |
21365 | & 'PHO_HARREM: val.spectator:(IFL,IPOS,INDXS)', | |
21366 | & IFL1,IPOS,SIGN(INDXS,INDXH) | |
21367 | C | |
21368 | IF(INDXH.GT.0) THEN | |
21369 | P1 = PSOFT1(1,INDXS+1) | |
21370 | P2 = PSOFT1(2,INDXS+1) | |
21371 | P3 = PSOFT1(3,INDXS+1) | |
21372 | P4 = PSOFT1(4,INDXS+1) | |
21373 | IJSI1(INDXS+1) = IFL2 | |
21374 | ELSE | |
21375 | P1 = PSOFT2(1,INDXS+1) | |
21376 | P2 = PSOFT2(2,INDXS+1) | |
21377 | P3 = PSOFT2(3,INDXS+1) | |
21378 | P4 = PSOFT2(4,INDXS+1) | |
21379 | IJSI2(INDXS+1) = IFL2 | |
21380 | ENDIF | |
21381 | C registration | |
21382 | CALL PHO_REGPAR(-1,IFL2,0,JM1,JM2,P1,P2,P3,P4, | |
21383 | & IHP,IGEN,ICB1,IVSW,IPOS,1) | |
21384 | IF(IDEB(28).GE.20) WRITE(LO,'(1X,A,3I5)') | |
21385 | & 'PHO_HARREM: val.spectator:(IFL,IPOS,INDXS)', | |
21386 | & IFL2,IPOS,SIGN(INDXS+1,INDXH) | |
21387 | IF(IPAMDL(18).EQ.0) THEN | |
21388 | C sea quark pair | |
21389 | CALL PHO_SEAFLA(JM1,IFL1,IFL2,PARMDL(161)) | |
21390 | IF(ICC1.GT.0) THEN | |
21391 | IFL1 = ABS(IFL1) | |
21392 | IFL2 = -IFL1 | |
21393 | ELSE | |
21394 | IFL1 = -ABS(IFL1) | |
21395 | IFL2 = -IFL1 | |
21396 | ENDIF | |
21397 | IF(DT_RNDM(P4).LT.0.5D0) THEN | |
21398 | ICB1 = ICC2 | |
21399 | CALL PHO_SELCOL(ICC1,0,ICA1,ICA2,ICC1,ICC2,2) | |
21400 | ELSE | |
21401 | ICA1 = ICC1 | |
21402 | CALL PHO_SELCOL(ICC2,0,ICB1,ICB2,ICC1,ICC2,2) | |
21403 | ENDIF | |
21404 | IF(INDXH.GT.0) THEN | |
21405 | P1 = PSOFT1(1,INDXS+2) | |
21406 | P2 = PSOFT1(2,INDXS+2) | |
21407 | P3 = PSOFT1(3,INDXS+2) | |
21408 | P4 = PSOFT1(4,INDXS+2) | |
21409 | IJSI1(INDXS+2) = IFL1 | |
21410 | ELSE | |
21411 | P1 = PSOFT2(1,INDXS+2) | |
21412 | P2 = PSOFT2(2,INDXS+2) | |
21413 | P3 = PSOFT2(3,INDXS+2) | |
21414 | P4 = PSOFT2(4,INDXS+2) | |
21415 | IJSI2(INDXS+2) = IFL1 | |
21416 | ENDIF | |
21417 | C registration | |
21418 | CALL PHO_REGPAR(-1,IFL1,0,JM1,JM2,P1,P2,P3,P4, | |
21419 | & IHP,IGEN,ICA1,0,IPOS,1) | |
21420 | IF(IDEB(28).GE.20) WRITE(LO,'(1X,A,3I5)') | |
21421 | & 'PHO_HARREM: sea spectator:(IFL,IPOS,INDXS)', | |
21422 | & IFL1,IPOS,SIGN(INDXS+2,INDXH) | |
21423 | C | |
21424 | IF(INDXH.GT.0) THEN | |
21425 | P1 = PSOFT1(1,INDXS+3) | |
21426 | P2 = PSOFT1(2,INDXS+3) | |
21427 | P3 = PSOFT1(3,INDXS+3) | |
21428 | P4 = PSOFT1(4,INDXS+3) | |
21429 | IJSI1(INDXS+3) = IFL2 | |
21430 | ELSE | |
21431 | P1 = PSOFT2(1,INDXS+3) | |
21432 | P2 = PSOFT2(2,INDXS+3) | |
21433 | P3 = PSOFT2(3,INDXS+3) | |
21434 | P4 = PSOFT2(4,INDXS+3) | |
21435 | IJSI2(INDXS+3) = IFL2 | |
21436 | ENDIF | |
21437 | C registration | |
21438 | CALL PHO_REGPAR(-1,IFL2,0,JM1,JM2,P1,P2,P3,P4, | |
21439 | & IHP,IGEN,ICB1,0,IPOS,1) | |
21440 | IF(IDEB(28).GE.20) WRITE(LO,'(1X,A,3I5)') | |
21441 | & 'PHO_HARREM: sea spectator:(IFL,IPOS,INDXS)', | |
21442 | & IFL2,IPOS,SIGN(INDXS+3,INDXH) | |
21443 | IUSED = 4 | |
21444 | ELSE | |
21445 | IUSED = 2 | |
21446 | ENDIF | |
21447 | C | |
21448 | C gluon from independent sea quarks | |
21449 | ELSE IF(IVAL.EQ.-1) THEN | |
21450 | IF(IPAMDL(18).EQ.0) THEN | |
21451 | CALL PHO_SELCOL(0,0,ICA1,ICA2,ICB1,ICB2,1) | |
21452 | CALL PHO_SEAFLA(JM1,IFL1,IFL2,PARMDL(161)) | |
21453 | IF(((ABS(IFL1).LE.6).AND.(IFL1.LT.0)) | |
21454 | & .OR.((ABS(IFL1).GT.6).AND.(IFL1.GT.0))) THEN | |
21455 | I = ICA1 | |
21456 | ICA1 = ICB1 | |
21457 | ICB1 = I | |
21458 | ENDIF | |
21459 | IF(DT_RNDM(P1).LT.0.5D0) THEN | |
21460 | CALL PHO_SELCOL(ICA1,ICA2,ICA1,ICA2,ICC1,ICC2,2) | |
21461 | ELSE | |
21462 | CALL PHO_SELCOL(ICB1,ICB2,ICB1,ICB2,ICC1,ICC2,2) | |
21463 | ENDIF | |
21464 | C remainder of hadron | |
21465 | IF(INDXH.GT.0) THEN | |
21466 | P1 = PSOFT1(1,INDXS) | |
21467 | P2 = PSOFT1(2,INDXS) | |
21468 | P3 = PSOFT1(3,INDXS) | |
21469 | P4 = PSOFT1(4,INDXS) | |
21470 | IJSI1(INDXS) = IFL1 | |
21471 | ELSE | |
21472 | P1 = PSOFT2(1,INDXS) | |
21473 | P2 = PSOFT2(2,INDXS) | |
21474 | P3 = PSOFT2(3,INDXS) | |
21475 | P4 = PSOFT2(4,INDXS) | |
21476 | IJSI2(INDXS) = IFL1 | |
21477 | ENDIF | |
21478 | C registration | |
21479 | CALL PHO_REGPAR(-1,IFL1,0,JM1,JM2,P1,P2,P3,P4, | |
21480 | & IHP,IGEN,ICA1,ICA2,IPOS,1) | |
21481 | IF(IDEB(28).GE.20) WRITE(LO,'(1X,A,3I5)') | |
21482 | & 'PHO_HARREM: sea spectator:(IFL,IPOS,INDXS)', | |
21483 | & IFL1,IPOS,SIGN(INDXS,INDXH) | |
21484 | C remnant of sea | |
21485 | IF(INDXH.GT.0) THEN | |
21486 | P1 = PSOFT1(1,INDXS-1) | |
21487 | P2 = PSOFT1(2,INDXS-1) | |
21488 | P3 = PSOFT1(3,INDXS-1) | |
21489 | P4 = PSOFT1(4,INDXS-1) | |
21490 | IJSI1(INDXS-1) = IFL2 | |
21491 | ELSE | |
21492 | P1 = PSOFT2(1,INDXS-1) | |
21493 | P2 = PSOFT2(2,INDXS-1) | |
21494 | P3 = PSOFT2(3,INDXS-1) | |
21495 | P4 = PSOFT2(4,INDXS-1) | |
21496 | IJSI2(INDXS-1) = IFL2 | |
21497 | ENDIF | |
21498 | C registration | |
21499 | CALL PHO_REGPAR(-1,IFL2,0,JM1,JM2,P1,P2,P3,P4, | |
21500 | & IHP,IGEN,ICB1,ICB2,IPOS,1) | |
21501 | IF(IDEB(28).GE.20) WRITE(LO,'(1X,A,3I5)') | |
21502 | & 'PHO_HARREM: sea spectator:(IFL,IPOS,INDXS)', | |
21503 | & IFL2,IPOS,SIGN(INDXS-1,INDXH) | |
21504 | IUSED = 2 | |
21505 | ELSE | |
21506 | CALL PHO_SELCOL(0,0,ICC1,ICA2,ICC2,ICB2,1) | |
21507 | IF(IDEB(28).GE.20) WRITE(LO,'(1X,A,I5)') | |
21508 | & 'PHO_HARREM: no spectator added:(INDXS)', | |
21509 | & SIGN(INDXS,INDXH) | |
21510 | IUSED = 0 | |
21511 | ENDIF | |
21512 | C | |
21513 | ELSE | |
21514 | WRITE(LO,'(1X,A,2I5)') | |
21515 | & 'PHO_HARREM:ERROR: unsupported combination of IVAL,IJH', | |
21516 | & IVAL,IJH | |
21517 | CALL PHO_ABORT | |
21518 | ENDIF | |
21519 | IC1 = ICC1 | |
21520 | IC2 = ICC2 | |
21521 | ENDIF | |
21522 | END | |
21523 | ||
21524 | *$ CREATE PHO_HARDIR.FOR | |
21525 | *COPY PHO_HARDIR | |
21526 | CDECK ID>, PHO_HARDIR | |
21527 | SUBROUTINE PHO_HARDIR(II,IVAL1,IVAL2,MSPAR1,MSPAR2,MHPAR1,MHPAR2, | |
21528 | & IREJ) | |
21529 | C********************************************************************** | |
21530 | C | |
21531 | C parton orientated formulation of direct scattering processes | |
21532 | C | |
21533 | C input: | |
21534 | C | |
21535 | C output: II particle combination (1..4) | |
21536 | C IVAL1,2 0 no valence quarks engaged | |
21537 | C 1 valence quarks engaged | |
21538 | C MSPAR1,2 number of realized soft partons | |
21539 | C MHPAR1,2 number of realized hard partons | |
21540 | C IREJ 1 failure | |
21541 | C 0 success | |
21542 | C | |
21543 | C********************************************************************** | |
21544 | IMPLICIT DOUBLE PRECISION (A-H,O-Z) | |
21545 | SAVE | |
21546 | ||
21547 | C input/output channels | |
21548 | INTEGER LI,LO | |
21549 | COMMON /POINOU/ LI,LO | |
21550 | C event debugging information | |
21551 | INTEGER NMAXD | |
21552 | PARAMETER (NMAXD=100) | |
21553 | INTEGER IDEB,KSPOM,KHPOM,KSREG,KHDIR,KACCEP,KSTRG,KHTRG,KSLOO, | |
21554 | & KHLOO,KSDPO,KHDPO,KEVENT,KSOFT,KHARD | |
21555 | COMMON /PODEBG/ IDEB(NMAXD),KSPOM,KHPOM,KSREG,KHDIR,KACCEP,KSTRG, | |
21556 | & KHTRG,KSLOO,KHLOO,KSDPO,KHDPO,KEVENT,KSOFT,KHARD | |
21557 | C model switches and parameters | |
21558 | CHARACTER*8 MDLNA | |
21559 | INTEGER ISWMDL,IPAMDL | |
21560 | DOUBLE PRECISION PARMDL | |
21561 | COMMON /POMDLS/ MDLNA(50),ISWMDL(50),PARMDL(400),IPAMDL(400) | |
21562 | C hard scattering parameters used for most recent hard interaction | |
21563 | INTEGER NFbeta,NF | |
21564 | DOUBLE PRECISION ALQCD2,BQCD | |
21565 | COMMON /POHAPA/ ALQCD2(3,4),BQCD(4),NFbeta,NF | |
21566 | C data of c.m. system of Pomeron / Reggeon exchange | |
21567 | INTEGER NPOSP,IDPDG1,IDBAM1,IDPDG2,IDBAM2 | |
21568 | DOUBLE PRECISION ECMP,PCMP,PMASSP,PVIRTP,GAMBEP, | |
21569 | & SIDP,CODP,SIFP,COFP | |
21570 | COMMON /POPCMS/ ECMP,PCMP,PMASSP(2),PVIRTP(2),GAMBEP(4), | |
21571 | & SIDP,CODP,SIFP,COFP,NPOSP(2), | |
21572 | & IDPDG1,IDBAM1,IDPDG2,IDBAM2 | |
21573 | C obsolete cut-off information | |
21574 | DOUBLE PRECISION PTCUT,PTANO,FPS,FPH,PSOMIN,XSOMIN | |
21575 | COMMON /POCUT1/ PTCUT(4),PTANO(4),FPS(4),FPH(4),PSOMIN,XSOMIN | |
21576 | C hard cross sections and MC selection weights | |
21577 | INTEGER Max_pro_2 | |
21578 | PARAMETER ( Max_pro_2 = 16 ) | |
21579 | INTEGER IHa_last,IHb_last,MH_pro_on,MH_tried, | |
21580 | & MH_acc_1,MH_acc_2 | |
21581 | DOUBLE PRECISION Hfac,HWgx,HSig,Hdpt,HEcm_last,HQ2a_last,HQ2b_last | |
21582 | COMMON /POHRCS/ Hfac(-1:Max_pro_2),HWgx(-1:Max_pro_2), | |
21583 | & HSig(-1:Max_pro_2),Hdpt(-1:Max_pro_2), | |
21584 | & HEcm_last,HQ2a_last,HQ2b_last,IHa_last,IHb_last, | |
21585 | & MH_pro_on(-1:Max_pro_2,0:4),MH_tried(-1:Max_pro_2,0:4), | |
21586 | & MH_acc_1(-1:Max_pro_2,0:4),MH_acc_2(-1:Max_pro_2,0:4) | |
21587 | C data on most recent hard scattering | |
21588 | INTEGER IA,IB,IC,ID,IV1,IV2,MSPR,IREJSC | |
21589 | DOUBLE PRECISION PTWANT,AS,AH,ALNS,ALNH,Z1MAX,Z1DIF,Z2MAX,Z2DIF, | |
21590 | & PT,PTfin,ETAC,ETAD,X1,X2,V,U,W,W1,AXX,QQPD,QQAL, | |
21591 | & PDF1,PDF2,WEIGHT,PHI1,PHI2,PHO1,PHO2 | |
21592 | COMMON /POCKIN/ PTWANT,AS,AH,ALNS,ALNH,Z1MAX,Z1DIF,Z2MAX,Z2DIF, | |
21593 | & PT,PTfin,ETAC,ETAD,X1,X2,V,U,W,W1,AXX, | |
21594 | & QQPD,QQAL,PDF1(-6:6),PDF2(-6:6),WEIGHT, | |
21595 | & PHI1(5),PHI2(5),PHO1(5),PHO2(5), | |
21596 | & IA,IB,IC,ID,IV1,IV2,MSPR,IREJSC | |
21597 | C light-cone x fractions and c.m. momenta of soft cut string ends | |
21598 | INTEGER MAXSOF | |
21599 | PARAMETER ( MAXSOF = 50 ) | |
21600 | INTEGER IJSI2,IJSI1 | |
21601 | DOUBLE PRECISION XS1,XS2,PSOFT1,PSOFT2 | |
21602 | COMMON /POSOFT/ XS1(MAXSOF),XS2(MAXSOF), | |
21603 | & PSOFT1(4,MAXSOF),PSOFT2(4,MAXSOF), | |
21604 | & IJSI1(MAXSOF),IJSI2(MAXSOF) | |
21605 | C hard scattering data | |
21606 | INTEGER MSCAHD | |
21607 | PARAMETER ( MSCAHD = 50 ) | |
21608 | INTEGER LSCAHD,LSC1HD,LSIDX, | |
21609 | & NINHD,N0INHD,NIVAL,N0IVAL,NOUTHD,NBRAHD,NPROHD | |
21610 | DOUBLE PRECISION PPH,PTHD,ETAHD,Q2SCA,PDFVA,XHD,VHD,X0HD | |
21611 | COMMON /POHSLT/ LSCAHD,LSC1HD,LSIDX(MSCAHD), | |
21612 | & PPH(8*MSCAHD,2),PTHD(MSCAHD),ETAHD(MSCAHD,2), | |
21613 | & Q2SCA(MSCAHD,2),PDFVA(MSCAHD,2), | |
21614 | & XHD(MSCAHD,2),VHD(MSCAHD),X0HD(MSCAHD,2), | |
21615 | & NINHD(MSCAHD,2),N0INHD(MSCAHD,2), | |
21616 | & NIVAL(MSCAHD,2),N0IVAL(MSCAHD,2), | |
21617 | & NOUTHD(MSCAHD,2),NBRAHD(MSCAHD,2),NPROHD(MSCAHD) | |
21618 | C internal rejection counters | |
21619 | INTEGER NMXJ | |
21620 | PARAMETER (NMXJ=60) | |
21621 | CHARACTER*10 REJTIT | |
21622 | INTEGER IFAIL | |
21623 | COMMON /POLOOP/ IFAIL(NMXJ),REJTIT(NMXJ) | |
21624 | ||
21625 | DIMENSION P1(4),P2(4),PD1(-6:6) | |
21626 | ||
21627 | PARAMETER ( TINY = 1.D-10 ) | |
21628 | ||
21629 | ITRY = 0 | |
21630 | NTRY = 10 | |
21631 | LSC1HD = 0 | |
21632 | LSIDX(1) = 1 | |
21633 | ||
21634 | C check phase space | |
21635 | IF(ECMP.LT.(2.D0*PTWANT+0.1D0)) THEN | |
21636 | IFAIL(18) = IFAIL(18)+1 | |
21637 | IREJ = 50 | |
21638 | RETURN | |
21639 | ENDIF | |
21640 | ||
21641 | AS = (PARMDL(160+II)/ECMP)**2 | |
21642 | AH = (2.D0*PTWANT/ECMP)**2 | |
21643 | ||
21644 | ALNS = LOG(AS) | |
21645 | ALNH = LOG(AH) | |
21646 | ||
21647 | XMAX = MAX(TINY,1.D0-AS) | |
21648 | Z1MAX = LOG(XMAX) | |
21649 | Z1DIF = Z1MAX-ALNH | |
21650 | C | |
21651 | C main loop to select hard and soft parton kinematics | |
21652 | C ----------------------------------------------------- | |
21653 | 120 CONTINUE | |
21654 | IREJ = 0 | |
21655 | ITRY = ITRY+1 | |
21656 | LSC1HD = LSC1HD+1 | |
21657 | IF(ITRY.GT.1) THEN | |
21658 | IFAIL(17) = IFAIL(17)+1 | |
21659 | IF(ITRY.GE.NTRY) THEN | |
21660 | IREJ = 1 | |
21661 | GOTO 450 | |
21662 | ENDIF | |
21663 | ENDIF | |
21664 | LINE = 0 | |
21665 | LSCAHD = 0 | |
21666 | XSS1 = 0.D0 | |
21667 | XSS2 = 0.D0 | |
21668 | MSPAR1 = 0 | |
21669 | MSPAR2 = 0 | |
21670 | ||
21671 | C select hard V,X | |
21672 | CALL PHO_HARSCA(1,II) | |
21673 | XSS1 = XSS1+X1 | |
21674 | XSS2 = XSS2+X2 | |
21675 | C debug output | |
21676 | IF(IDEB(25).GE.20) THEN | |
21677 | WRITE(LO,'(1X,A,2E12.4,2I5)') | |
21678 | & 'PHO_HARDIR: AS,XMAX,process ID,ITRY', | |
21679 | & AS,XMAX,MSPR,ITRY | |
21680 | WRITE(LO,'(1X,A,4E12.4)') 'HARD X1,2 SUM X1,2', | |
21681 | & X1,X2,XSS1,XSS2 | |
21682 | ENDIF | |
21683 | ||
21684 | IF(MSPR.LE.11) THEN | |
21685 | IF((XSS2.GT.XMAX).OR.((1.D0-XSS2).LT.AS)) GOTO 120 | |
21686 | ELSE IF(MSPR.LE.13) THEN | |
21687 | IF((XSS1.GT.XMAX).OR.((1.D0-XSS1).LT.AS)) GOTO 120 | |
21688 | ENDIF | |
21689 | ||
21690 | C fill /POHSLT/ | |
21691 | LSCAHD = 1 | |
21692 | LSIDX(1) = 1 | |
21693 | XHD(1,1) = X1 | |
21694 | XHD(1,2) = X2 | |
21695 | X0HD(1,1) = X1 | |
21696 | X0HD(1,2) = X2 | |
21697 | VHD(1) = V | |
21698 | ETAHD(1,1) = ETAC | |
21699 | ETAHD(1,2) = ETAD | |
21700 | PTHD(1) = PT | |
21701 | Q2SCA(1,1) = QQPD | |
21702 | Q2SCA(1,2) = QQPD | |
21703 | NPROHD(1) = MSPR | |
21704 | NBRAHD(1,1)= IDPDG1 | |
21705 | NBRAHD(1,2)= IDPDG2 | |
21706 | DO 45 I=1,4 | |
21707 | PPH(I,1) = PHI1(I) | |
21708 | PPH(I,2) = PHI2(I) | |
21709 | PPH(4+I,1) = PHO1(I) | |
21710 | PPH(4+I,2) = PHO2(I) | |
21711 | 45 CONTINUE | |
21712 | C valence quarks | |
21713 | IVAL1 = IV1 | |
21714 | IVAL2 = IV2 | |
21715 | PDFVA(1,1) = 0.D0 | |
21716 | PDFVA(1,2) = 0.D0 | |
21717 | C parton flavours | |
21718 | IF(MSPR.LE.11) THEN | |
21719 | NINHD(1,1) = IDPDG1 | |
21720 | NINHD(1,2) = IB | |
21721 | PDFVA(1,2) = PDF2(IB) | |
21722 | KHDIR = 1 | |
21723 | ELSE IF(MSPR.LE.13) THEN | |
21724 | NINHD(1,1) = IA | |
21725 | PDFVA(1,1) = PDF1(IA) | |
21726 | NINHD(1,2) = IDPDG2 | |
21727 | KHDIR = 2 | |
21728 | ELSE | |
21729 | NINHD(1,1) = IDPDG1 | |
21730 | NINHD(1,2) = IDPDG2 | |
21731 | KHDIR = 3 | |
21732 | ENDIF | |
21733 | N0INHD(1,1) = NINHD(1,1) | |
21734 | N0INHD(1,2) = NINHD(1,2) | |
21735 | N0IVAL(1,1) = IVAL1 | |
21736 | N0IVAL(1,2) = IVAL2 | |
21737 | NOUTHD(1,1) = IC | |
21738 | NOUTHD(1,2) = ID | |
21739 | ||
21740 | C reweight according to photon virtuality | |
21741 | IF(MSPR.NE.14) THEN | |
21742 | IF(IPAMDL(115).GE.1) THEN | |
21743 | WGX = 1.D0 | |
21744 | IF(((MSPR.EQ.10).OR.(MSPR.EQ.11)).AND.(IDPDG2.EQ.22)) THEN | |
21745 | QQPD = Q2SCA(1,2) | |
21746 | IF(IPAMDL(115).EQ.1) THEN | |
21747 | IF(QQPD.LT.(PVIRTP(2)+PARMDL(144))) THEN | |
21748 | WGX = 0.D0 | |
21749 | ELSE | |
21750 | WGX = LOG(QQPD/(PVIRTP(2)+PARMDL(144))) | |
21751 | & /LOG(QQPD/PARMDL(144)) | |
21752 | ENDIF | |
21753 | IF(NINHD(1,2).EQ.0) WGX = WGX*WGX | |
21754 | ELSE IF(IPAMDL(115).EQ.2) THEN | |
21755 | CALL PHO_PDF(2,X2,QQPD,PVIRTP(2),PD1) | |
21756 | WGX = PD1(IB)/PDFVA(1,2) | |
21757 | ENDIF | |
21758 | ELSE IF(((MSPR.EQ.12).OR.(MSPR.EQ.13)) | |
21759 | & .AND.(IDPDG1.EQ.22)) THEN | |
21760 | QQPD = Q2SCA(1,1) | |
21761 | IF(IPAMDL(115).EQ.1) THEN | |
21762 | IF(QQPD.LT.(PVIRTP(1)+PARMDL(144))) THEN | |
21763 | WGX = 0.D0 | |
21764 | ELSE | |
21765 | WGX = LOG(QQPD/(PVIRTP(1)+PARMDL(144))) | |
21766 | & /LOG(QQPD/PARMDL(144)) | |
21767 | ENDIF | |
21768 | IF(NINHD(1,1).EQ.0) WGX = WGX*WGX | |
21769 | ELSE IF(IPAMDL(115).EQ.2) THEN | |
21770 | CALL PHO_PDF(1,X1,QQPD,PVIRTP(1),PD1) | |
21771 | WGX = PD1(IA)/PDFVA(1,1) | |
21772 | ENDIF | |
21773 | ENDIF | |
21774 | ||
21775 | IF(IDEB(25).GE.25) | |
21776 | & WRITE(LO,'(1X,2A,/5X,I10,I3,1P6E10.3)') 'PHO_HARDIR: ', | |
21777 | & 're-weight with (EVE, MSPR, X1/2, Q2, PV1/2, W1/W2)', | |
21778 | & KEVENT,MSPR,X1,X2,QQPD,PVIRTP,WGX | |
21779 | ||
21780 | IF(WGX.LT.DT_RNDM(WGX)) THEN | |
21781 | IREJ = 50 | |
21782 | RETURN | |
21783 | ENDIF | |
21784 | ||
21785 | IF(WGX.GT.1.01D0) | |
21786 | & WRITE(LO,'(1X,2A,/5X,I10,I3,1P6E10.3)') 'PHO_HARDIR: ', | |
21787 | & 're-weight >1 (EVE, MSPR, X1/2, Q2, PV1/2, W1/W2)', | |
21788 | & KEVENT,MSPR,X1,X2,QQPD,PVIRTP,WGX | |
21789 | ||
21790 | ENDIF | |
21791 | ENDIF | |
21792 | ||
21793 | C generate ISR | |
21794 | IF((MSPR.NE.14).AND.(ISWMDL(8).GE.2)) THEN | |
21795 | IF(IPAMDL(109).EQ.1) THEN | |
21796 | Q2H = PARMDL(93)*PT**2 | |
21797 | ELSE | |
21798 | Q2H = -PARMDL(93)*VHD(1)*XHD(1,1)*XHD(1,2)*ECMP*ECMP | |
21799 | ENDIF | |
21800 | XHMAX1 = 1.D0 - XSS1 - AS + XHD(1,1) | |
21801 | XHMAX2 = 1.D0 - XSS2 - AS + XHD(1,2) | |
21802 | DO 42 J=1,4 | |
21803 | P1(J) = PPH(4+J,1) | |
21804 | P2(J) = PPH(4+J,2) | |
21805 | 42 CONTINUE | |
21806 | CALL PHO_HARISR(-1,P1,P2,NOUTHD(1,1),NOUTHD(1,2),N0INHD(1,1), | |
21807 | & N0INHD(1,2),N0IVAL(1,1),N0IVAL(1,2),Q2H,X0HD(1,1),X0HD(1,2), | |
21808 | & XHMAX1,XHMAX2,IFL1,IFL2,IVAL1,IVAL2,XISR1,XISR2,IREJ) | |
21809 | XSS1 = XSS1+XISR1-XHD(1,1) | |
21810 | XSS2 = XSS2+XISR2-XHD(1,2) | |
21811 | NINHD(1,1) = IFL1 | |
21812 | NINHD(1,2) = IFL2 | |
21813 | XHD(1,1) = XISR1 | |
21814 | XHD(1,2) = XISR2 | |
21815 | ELSE | |
21816 | IFL1 = NINHD(1,1) | |
21817 | IFL2 = NINHD(1,2) | |
21818 | ENDIF | |
21819 | NIVAL(1,1) = IVAL1 | |
21820 | NIVAL(1,2) = IVAL2 | |
21821 | ||
21822 | C add photon/hadron remnant | |
21823 | ||
21824 | C incoming gluon | |
21825 | IF(IFL2.EQ.0) THEN | |
21826 | XMAXX = 1.D0 - XSS2 - AS | |
21827 | XMAXH = MIN(XMAXX,PARMDL(44)) | |
21828 | CALL PHO_HADSP2(IDBAM2,XSS2,XMAXH,XS2,IREJ) | |
21829 | IVAL2 = 1 | |
21830 | MSPAR1 = 0 | |
21831 | MSPAR2 = 2 | |
21832 | MHPAR1 = 1 | |
21833 | MHPAR2 = 1 | |
21834 | ELSE IF(IFL1.EQ.0) THEN | |
21835 | XMAXX = 1.D0 - XSS1 - AS | |
21836 | XMAXH = MIN(XMAXX,PARMDL(44)) | |
21837 | CALL PHO_HADSP2(IDBAM1,XSS1,XMAXH,XS1,IREJ) | |
21838 | IVAL1 = 1 | |
21839 | MSPAR1 = 2 | |
21840 | MSPAR2 = 0 | |
21841 | MHPAR1 = 1 | |
21842 | MHPAR2 = 1 | |
21843 | ||
21844 | C incoming quark | |
21845 | ELSE IF(ABS(IFL2).LE.12) THEN | |
21846 | IF(IVAL2.EQ.1) THEN | |
21847 | XS2(1) = 1.D0 - XSS2 | |
21848 | MSPAR1 = 0 | |
21849 | MSPAR2 = 1 | |
21850 | MHPAR1 = 1 | |
21851 | MHPAR2 = 1 | |
21852 | ELSE | |
21853 | XMAXX = 1.D0 - XSS2 - AS | |
21854 | XMAXH = MIN(XMAXX,PARMDL(44)) | |
21855 | CALL PHO_HADSP3(IDBAM2,XSS2,XMAXH,XS2,IREJ) | |
21856 | MSPAR1 = 0 | |
21857 | MSPAR2 = 3 | |
21858 | MHPAR1 = 1 | |
21859 | MHPAR2 = 1 | |
21860 | ENDIF | |
21861 | ELSE IF(ABS(IFL1).LE.12) THEN | |
21862 | IF(IVAL1.EQ.1) THEN | |
21863 | XS1(1) = 1.D0 - XSS1 | |
21864 | MSPAR1 = 1 | |
21865 | MSPAR2 = 0 | |
21866 | MHPAR1 = 1 | |
21867 | MHPAR2 = 1 | |
21868 | ELSE | |
21869 | XMAXX = 1.D0 - XSS1 - AS | |
21870 | XMAXH = MIN(XMAXX,PARMDL(44)) | |
21871 | CALL PHO_HADSP3(IDBAM1,XSS1,XMAXH,XS1,IREJ) | |
21872 | MSPAR1 = 3 | |
21873 | MSPAR2 = 0 | |
21874 | MHPAR1 = 1 | |
21875 | MHPAR2 = 1 | |
21876 | ENDIF | |
21877 | ||
21878 | C double direct process | |
21879 | ELSE IF(MSPR.EQ.14) THEN | |
21880 | MSPAR1 = 0 | |
21881 | MSPAR2 = 0 | |
21882 | MHPAR1 = 1 | |
21883 | MHPAR2 = 1 | |
21884 | ||
21885 | C unknown process | |
21886 | ELSE | |
21887 | WRITE(LO,'(/1X,A,I3/)') | |
21888 | & 'PHO_HARDIR:ERROR: unsupported hard process (MSPR)',MSPR | |
21889 | CALL PHO_ABORT | |
21890 | ENDIF | |
21891 | ||
21892 | IF(IREJ.NE.0) THEN | |
21893 | IF(IDEB(25).GE.3) WRITE(LO,'(1X,A,3I5)') | |
21894 | & 'PHO_HARDIR: int. rejection (MSPR,ITRY,NTRY)',MSPR,ITRY,NTRY | |
21895 | GOTO 120 | |
21896 | ENDIF | |
21897 | ||
21898 | C soft particle momenta | |
21899 | IF(MSPAR1.GT.0) THEN | |
21900 | DO 50 I=1,MSPAR1 | |
21901 | PSOFT1(1,I) = 0.D0 | |
21902 | PSOFT1(2,I) = 0.D0 | |
21903 | PSOFT1(3,I) = XS1(I)*ECMP/2.D0 | |
21904 | PSOFT1(4,I) = XS1(I)*ECMP/2.D0 | |
21905 | 50 CONTINUE | |
21906 | ENDIF | |
21907 | IF(MSPAR2.GT.0) THEN | |
21908 | DO 55 I=1,MSPAR2 | |
21909 | PSOFT2(1,I) = 0.D0 | |
21910 | PSOFT2(2,I) = 0.D0 | |
21911 | PSOFT2(3,I) = -XS2(I)*ECMP/2.D0 | |
21912 | PSOFT2(4,I) = XS2(I)*ECMP/2.D0 | |
21913 | 55 CONTINUE | |
21914 | ENDIF | |
21915 | C process counting | |
21916 | MH_acc_1(MSPR,II) = MH_acc_1(MSPR,II)+1 | |
21917 | KSOFT = MAX(MSPAR1,MSPAR2) | |
21918 | KHARD = MAX(MHPAR1,MHPAR2) | |
21919 | C debug output | |
21920 | IF(IDEB(25).GE.10) THEN | |
21921 | WRITE(LO,'(/1X,A,2I3,3I5)') | |
21922 | & 'PHO_HARDIR: accepted IVAL1,IVAL2,MSPR,ITRY,NTRY', | |
21923 | & IVAL1,IVAL2,MSPR,ITRY,NTRY | |
21924 | IF(MSPAR1.GT.0) THEN | |
21925 | WRITE(LO,'(5X,A,I4)') 'soft x particle 1:',MSPAR1 | |
21926 | DO 105 I=1,MSPAR1 | |
21927 | WRITE(LO,'(10X,I3,E12.3)') I,XS1(I) | |
21928 | 105 CONTINUE | |
21929 | ENDIF | |
21930 | IF(MSPAR2.GT.0) THEN | |
21931 | WRITE(LO,'(5X,A,I4)') 'soft x particle 2:',MSPAR2 | |
21932 | DO 106 I=1,MSPAR2 | |
21933 | WRITE(LO,'(10X,I3,E12.3)') I,XS2(I) | |
21934 | 106 CONTINUE | |
21935 | ENDIF | |
21936 | WRITE(LO,'(5X,A,I4)') 'ini.hard X/flavor particle 1:',MHPAR1 | |
21937 | WRITE(LO,'(10X,I3,E12.3,I8)') 1,XHD(1,1),NINHD(1,1) | |
21938 | WRITE(LO,'(5X,A,I4)') 'fin.hard momenta particle 1:',MHPAR1 | |
21939 | WRITE(LO,'(10X,I3,4E12.3,I8)') 1,(PPH(K,1),K=5,8),NOUTHD(1,1) | |
21940 | WRITE(LO,'(5X,A,I4)') 'ini.hard X/flavour particle 2:',MHPAR2 | |
21941 | WRITE(LO,'(10X,I3,E12.3,I8)') 1,XHD(1,2),NINHD(1,2) | |
21942 | WRITE(LO,'(5X,A,I4)') 'fin.hard momenta particle 2:',MHPAR2 | |
21943 | WRITE(LO,'(10X,I3,4E12.3,I8)') 1,(PPH(K,2),K=5,8),NOUTHD(1,2) | |
21944 | ENDIF | |
21945 | RETURN | |
21946 | ||
21947 | 450 CONTINUE | |
21948 | IFAIL(16) = IFAIL(16)+1 | |
21949 | IF(IDEB(25).GE.2) THEN | |
21950 | WRITE(LO,'(1X,A,3I5)') | |
21951 | & 'PHO_HARDIR: rejection (ITRY,NTRY,IREJ)',ITRY,NTRY,IREJ | |
21952 | WRITE(LO,'(5X,A,E12.4)') 'available energy:',ECMP | |
21953 | IF(IDEB(25).GE.5) THEN | |
21954 | CALL PHO_PREVNT(0) | |
21955 | ELSE | |
21956 | CALL PHO_PREVNT(-1) | |
21957 | ENDIF | |
21958 | ENDIF | |
21959 | ||
21960 | END | |
21961 | ||
21962 | *$ CREATE PHO_POMSCA.FOR | |
21963 | *COPY PHO_POMSCA | |
21964 | CDECK ID>, PHO_POMSCA | |
21965 | SUBROUTINE PHO_POMSCA(II,MSPOM,MHPOM,MSREG,IVAL1,IVAL2, | |
21966 | & MSPAR1,MSPAR2,MHPAR1,MHPAR2,IREJ) | |
21967 | C********************************************************************** | |
21968 | C | |
21969 | C parton orientated formulation of soft and hard inelastic events | |
21970 | C | |
21971 | C | |
21972 | C input: II particle combiantion (1..4) | |
21973 | C MSPOM number of soft pomerons | |
21974 | C MHPOM number of semihard pomerons | |
21975 | C MSREG number of soft reggeons | |
21976 | C | |
21977 | C output: IVAL1,2 0 no valence quark engaged | |
21978 | C otherwise: position of valence quark engaged | |
21979 | C neg.number: gluon connected to valence quark | |
21980 | C by color flow | |
21981 | C MSPAR1,2 number of realized soft partons | |
21982 | C MHPAR1,2 number of realized hard partons | |
21983 | C IREJ 1 failure | |
21984 | C 0 success | |
21985 | C | |
21986 | C********************************************************************** | |
21987 | IMPLICIT DOUBLE PRECISION (A-H,O-Z) | |
21988 | SAVE | |
21989 | ||
21990 | PARAMETER (TINY = 1.D-30 ) | |
21991 | ||
21992 | C input/output channels | |
21993 | INTEGER LI,LO | |
21994 | COMMON /POINOU/ LI,LO | |
21995 | C event debugging information | |
21996 | INTEGER NMAXD | |
21997 | PARAMETER (NMAXD=100) | |
21998 | INTEGER IDEB,KSPOM,KHPOM,KSREG,KHDIR,KACCEP,KSTRG,KHTRG,KSLOO, | |
21999 | & KHLOO,KSDPO,KHDPO,KEVENT,KSOFT,KHARD | |
22000 | COMMON /PODEBG/ IDEB(NMAXD),KSPOM,KHPOM,KSREG,KHDIR,KACCEP,KSTRG, | |
22001 | & KHTRG,KSLOO,KHLOO,KSDPO,KHDPO,KEVENT,KSOFT,KHARD | |
22002 | C model switches and parameters | |
22003 | CHARACTER*8 MDLNA | |
22004 | INTEGER ISWMDL,IPAMDL | |
22005 | DOUBLE PRECISION PARMDL | |
22006 | COMMON /POMDLS/ MDLNA(50),ISWMDL(50),PARMDL(400),IPAMDL(400) | |
22007 | C general process information | |
22008 | INTEGER IPROCE,IDNODF,IDIFR1,IDIFR2,IDDPOM,IPRON | |
22009 | COMMON /POPRCS/ IPROCE,IDNODF,IDIFR1,IDIFR2,IDDPOM,IPRON(15,4) | |
22010 | C nucleon-nucleus / nucleus-nucleus interface to DPMJET | |
22011 | INTEGER IDEQP,IDEQB,IHFLD,IHFLS | |
22012 | DOUBLE PRECISION ECMN,PCMN,SECM,SPCM,XPSUB,XTSUB | |
22013 | COMMON /POHDFL/ ECMN,PCMN,SECM,SPCM,XPSUB,XTSUB, | |
22014 | & IDEQP(2),IDEQB(2),IHFLD(2,2),IHFLS(2) | |
22015 | C event weights and generated cross section | |
22016 | INTEGER IPOWGC,ISWCUT,IVWGHT | |
22017 | DOUBLE PRECISION SIGGEN,HSWGHT,HSWCUT,EVWGHT | |
22018 | COMMON /POWGHT/ SIGGEN(4),HSWGHT(0:10),HSWCUT(20),EVWGHT(0:10), | |
22019 | & IPOWGC(0:10),ISWCUT(20),IVWGHT(0:10) | |
22020 | C hard cross sections and MC selection weights | |
22021 | INTEGER Max_pro_2 | |
22022 | PARAMETER ( Max_pro_2 = 16 ) | |
22023 | INTEGER IHa_last,IHb_last,MH_pro_on,MH_tried, | |
22024 | & MH_acc_1,MH_acc_2 | |
22025 | DOUBLE PRECISION Hfac,HWgx,HSig,Hdpt,HEcm_last,HQ2a_last,HQ2b_last | |
22026 | COMMON /POHRCS/ Hfac(-1:Max_pro_2),HWgx(-1:Max_pro_2), | |
22027 | & HSig(-1:Max_pro_2),Hdpt(-1:Max_pro_2), | |
22028 | & HEcm_last,HQ2a_last,HQ2b_last,IHa_last,IHb_last, | |
22029 | & MH_pro_on(-1:Max_pro_2,0:4),MH_tried(-1:Max_pro_2,0:4), | |
22030 | & MH_acc_1(-1:Max_pro_2,0:4),MH_acc_2(-1:Max_pro_2,0:4) | |
22031 | C hard scattering parameters used for most recent hard interaction | |
22032 | INTEGER NFbeta,NF | |
22033 | DOUBLE PRECISION ALQCD2,BQCD | |
22034 | COMMON /POHAPA/ ALQCD2(3,4),BQCD(4),NFbeta,NF | |
22035 | C data of c.m. system of Pomeron / Reggeon exchange | |
22036 | INTEGER NPOSP,IDPDG1,IDBAM1,IDPDG2,IDBAM2 | |
22037 | DOUBLE PRECISION ECMP,PCMP,PMASSP,PVIRTP,GAMBEP, | |
22038 | & SIDP,CODP,SIFP,COFP | |
22039 | COMMON /POPCMS/ ECMP,PCMP,PMASSP(2),PVIRTP(2),GAMBEP(4), | |
22040 | & SIDP,CODP,SIFP,COFP,NPOSP(2), | |
22041 | & IDPDG1,IDBAM1,IDPDG2,IDBAM2 | |
22042 | C obsolete cut-off information | |
22043 | DOUBLE PRECISION PTCUT,PTANO,FPS,FPH,PSOMIN,XSOMIN | |
22044 | COMMON /POCUT1/ PTCUT(4),PTANO(4),FPS(4),FPH(4),PSOMIN,XSOMIN | |
22045 | C some hadron information, will be deleted in future versions | |
22046 | INTEGER NFS | |
22047 | DOUBLE PRECISION QMASS,BET,PCOUDI,PNORM,VALPRG | |
22048 | COMMON /POHDRN/ QMASS(6),BET,PCOUDI,PNORM,VALPRG(2),NFS | |
22049 | C data on most recent hard scattering | |
22050 | INTEGER IA,IB,IC,ID,IV1,IV2,MSPR,IREJSC | |
22051 | DOUBLE PRECISION PTWANT,AS,AH,ALNS,ALNH,Z1MAX,Z1DIF,Z2MAX,Z2DIF, | |
22052 | & PT,PTfin,ETAC,ETAD,X1,X2,V,U,W,W1,AXX,QQPD,QQAL, | |
22053 | & PDF1,PDF2,WEIGHT,PHI1,PHI2,PHO1,PHO2 | |
22054 | COMMON /POCKIN/ PTWANT,AS,AH,ALNS,ALNH,Z1MAX,Z1DIF,Z2MAX,Z2DIF, | |
22055 | & PT,PTfin,ETAC,ETAD,X1,X2,V,U,W,W1,AXX, | |
22056 | & QQPD,QQAL,PDF1(-6:6),PDF2(-6:6),WEIGHT, | |
22057 | & PHI1(5),PHI2(5),PHO1(5),PHO2(5), | |
22058 | & IA,IB,IC,ID,IV1,IV2,MSPR,IREJSC | |
22059 | C light-cone x fractions and c.m. momenta of soft cut string ends | |
22060 | INTEGER MAXSOF | |
22061 | PARAMETER ( MAXSOF = 50 ) | |
22062 | INTEGER IJSI2,IJSI1 | |
22063 | DOUBLE PRECISION XS1,XS2,PSOFT1,PSOFT2 | |
22064 | COMMON /POSOFT/ XS1(MAXSOF),XS2(MAXSOF), | |
22065 | & PSOFT1(4,MAXSOF),PSOFT2(4,MAXSOF), | |
22066 | & IJSI1(MAXSOF),IJSI2(MAXSOF) | |
22067 | C hard scattering data | |
22068 | INTEGER MSCAHD | |
22069 | PARAMETER ( MSCAHD = 50 ) | |
22070 | INTEGER LSCAHD,LSC1HD,LSIDX, | |
22071 | & NINHD,N0INHD,NIVAL,N0IVAL,NOUTHD,NBRAHD,NPROHD | |
22072 | DOUBLE PRECISION PPH,PTHD,ETAHD,Q2SCA,PDFVA,XHD,VHD,X0HD | |
22073 | COMMON /POHSLT/ LSCAHD,LSC1HD,LSIDX(MSCAHD), | |
22074 | & PPH(8*MSCAHD,2),PTHD(MSCAHD),ETAHD(MSCAHD,2), | |
22075 | & Q2SCA(MSCAHD,2),PDFVA(MSCAHD,2), | |
22076 | & XHD(MSCAHD,2),VHD(MSCAHD),X0HD(MSCAHD,2), | |
22077 | & NINHD(MSCAHD,2),N0INHD(MSCAHD,2), | |
22078 | & NIVAL(MSCAHD,2),N0IVAL(MSCAHD,2), | |
22079 | & NOUTHD(MSCAHD,2),NBRAHD(MSCAHD,2),NPROHD(MSCAHD) | |
22080 | C table of particle indices for recursive PHOJET calls | |
22081 | INTEGER MAXIPX | |
22082 | PARAMETER ( MAXIPX = 100 ) | |
22083 | INTEGER IPOPOS,IPORES,IPOIX1,IPOIX2,IPOIX3 | |
22084 | COMMON /PORECU/ IPOPOS(2,MAXIPX),IPORES(MAXIPX), | |
22085 | & IPOIX1,IPOIX2,IPOIX3 | |
22086 | C internal rejection counters | |
22087 | INTEGER NMXJ | |
22088 | PARAMETER (NMXJ=60) | |
22089 | CHARACTER*10 REJTIT | |
22090 | INTEGER IFAIL | |
22091 | COMMON /POLOOP/ IFAIL(NMXJ),REJTIT(NMXJ) | |
22092 | ||
22093 | DIMENSION P1(4),P2(4),PD1(-6:6) | |
22094 | ||
22095 | IF(IDEB(24).GT.20) WRITE(LO,'(1X,A,3I5)') | |
22096 | & 'PHO_POMSCA: MSPOM,MHPOM,MSREG',MSPOM,MHPOM,MSREG | |
22097 | ||
22098 | ITRY = 0 | |
22099 | NTRY = 10 | |
22100 | IREJ = 0 | |
22101 | INMAX = 10 | |
22102 | MHARD = MHPOM | |
22103 | ||
22104 | C phase space limitation (single hard valence-valence quark scattering) | |
22105 | IF(MHPOM.GT.0) THEN | |
22106 | Emin = 2.D0*PTWANT + 0.2D0 | |
22107 | IF(ECMP.LT.Emin) THEN | |
22108 | IF(IDEB(24).GE.1) WRITE(LO,'(1X,A,1P,3E10.3)') 'PHO_POMSCA: ', | |
22109 | & 'kin. rejection (1) (Ecm,Ptcut,Emin)',ECMP,PTWANT,Emin | |
22110 | IREJ = 50 | |
22111 | IFAIL(6) = IFAIL(6) + 1 | |
22112 | RETURN | |
22113 | ENDIF | |
22114 | ENDIF | |
22115 | ||
22116 | SAS = PARMDL(160+II)/ECMP | |
22117 | SAH = 2.D0*PTWANT/ECMP | |
22118 | AS = SAS**2 | |
22119 | AH = SAH**2 | |
22120 | ||
22121 | C save energy for leading particle effect | |
22122 | XMAXP1 = 1.D0 | |
22123 | if(IHFLS(1).ne.0) XMAXP1 = 1.D0-PARMDL(165)*XPSUB | |
22124 | XMAXP2 = 1.D0 | |
22125 | if(IHFLS(2).ne.0) XMAXP2 = 1.D0-PARMDL(165)*XTSUB | |
22126 | ||
22127 | C | |
22128 | C main loop to select hard and soft parton kinematics | |
22129 | C ----------------------------------------------------- | |
22130 | IFAIL(31) = IFAIL(31)+MHARD | |
22131 | 20 CONTINUE | |
22132 | IREJ = 0 | |
22133 | IHARD = 0 | |
22134 | LSC1HD = 0 | |
22135 | ITRY = ITRY+1 | |
22136 | IF(ITRY.GT.1) IFAIL(5) = IFAIL(5)+1 | |
22137 | IF(ITRY.GE.NTRY) THEN | |
22138 | IREJ = 1 | |
22139 | GOTO 450 | |
22140 | ENDIF | |
22141 | LINE = 0 | |
22142 | LSCAHD = 0 | |
22143 | IF((IPAMDL(13).GT.0).AND.(IPOIX3.EQ.0).AND.(IPROCE.EQ.1)) THEN | |
22144 | XSS1 = MAX(0.D0,1.D0-XPSUB) | |
22145 | XSS2 = MAX(0.D0,1.D0-XTSUB) | |
22146 | ELSE | |
22147 | XSS1 = 0.D0 | |
22148 | XSS2 = 0.D0 | |
22149 | ENDIF | |
22150 | 22 continue | |
22151 | ||
22152 | C partons needed to construct soft/hard interactions | |
22153 | MSPAR1 = 2*MSPOM+MSREG+MHPOM | |
22154 | MSPAR2 = MSPAR1 | |
22155 | MHPAR1 = MHPOM | |
22156 | MHPAR2 = MHPOM | |
22157 | ||
22158 | C number of strings | |
22159 | MSCHA = 2*MSPOM+MSREG | |
22160 | MHCHA = 2*MHPOM | |
22161 | ||
22162 | KSOFT = MSCHA | |
22163 | KHARD = MHCHA | |
22164 | ||
22165 | C check actual phase space limit | |
22166 | XX = SAS*DBLE(MSCHA)+SAH*DBLE(MHCHA)/2.D0 | |
22167 | IF(XX.GE.1.D0) THEN | |
22168 | IF(IDEB(24).GE.3) WRITE(LO,'(1X,2A,/1X,4I3,1P4E12.4)') | |
22169 | & 'PHO_POMSCA: internal kin. rejection ', | |
22170 | & '(MSpom,MHpom,MSchain,MHchain,Ecm,AS,AH,XX):', | |
22171 | & MSPOM,MHPOM,MSCHA,MHCHA,ECMP,AS,AH,XX | |
22172 | if(MSPOM+MSREG+MHPOM.gt.1) then | |
22173 | if(MSREG.gt.0) then | |
22174 | MSREG = MSREG-1 | |
22175 | else if(MSPOM.gt.0) THEN | |
22176 | MSPOM = MSPOM-1 | |
22177 | else if(MHPOM.gt.1) then | |
22178 | MHPOM = MHPOM-1 | |
22179 | endif | |
22180 | goto 22 | |
22181 | endif | |
22182 | IF(IDEB(24).GE.1) WRITE(LO,'(1X,A,1P2E10.3)') | |
22183 | & 'PHO_POMSCA: kin. rejection (2) (Ecm,Ptcut)',ECMP,PTWANT | |
22184 | IREJ = 50 | |
22185 | IFAIL(6) = IFAIL(6) + 1 | |
22186 | RETURN | |
22187 | ENDIF | |
22188 | ||
22189 | XMAXX1 = MAX(TINY,1.D0-MIN(MSPAR1,1)*AS-MIN(MHPAR1,1)*AH) | |
22190 | XMAXX2 = MAX(TINY,1.D0-MIN(MSPAR2,1)*AS-MIN(MHPAR2,1)*AH) | |
22191 | ||
22192 | C very low energy phase space restriction | |
22193 | if(MHARD.gt.0) then | |
22194 | if((XMAXX1*XMAXX2.le.AH)) then | |
22195 | IF(IDEB(24).GE.1) WRITE(LO,'(1X,A,1P2E10.3)') | |
22196 | & 'PHO_POMSCA: kin. rejection (3) (Ecm,Ptcut)',ECMP,PTWANT | |
22197 | IREJ = 50 | |
22198 | IFAIL(6) = IFAIL(6) + 1 | |
22199 | RETURN | |
22200 | endif | |
22201 | endif | |
22202 | ||
22203 | AS = MAX(AS,PSOMIN/PCMP) | |
22204 | ALNS = LOG(AS) | |
22205 | ALNH = LOG(AH) | |
22206 | Z1MAX = LOG(XMAXX1) | |
22207 | Z2MAX = LOG(XMAXX2) | |
22208 | Z1DIF = Z1MAX+Z2MAX-ALNH | |
22209 | Z2DIF = Z1DIF | |
22210 | PTMAX = 0.D0 | |
22211 | C | |
22212 | C select hard parton momenta | |
22213 | C ------------------- begin of inner loop ------------------- | |
22214 | IF(IPOIX3.EQ.0) IPOWGC(4+II) = 0 | |
22215 | IF(MHARD.GT.MSCAHD) THEN | |
22216 | WRITE(LO,'(1X,2A,2I3)') 'PHO_POMSCA: ', | |
22217 | & 'no space left in /POHSLT/ (MHARD,MSCAHD):',MHARD,MSCAHD | |
22218 | IREJ = 1 | |
22219 | RETURN | |
22220 | ENDIF | |
22221 | DO 11 NN=1,MHARD | |
22222 | C | |
22223 | C generate one resolved hard scattering | |
22224 | C | |
22225 | C high-pt option | |
22226 | IF((NN.EQ.1).AND.(II.EQ.1).AND.(HSWCUT(4+II).GT.PTWANT)) THEN | |
22227 | CALL PHO_HARINT(-1,ECMP,PVIRTP(1),PVIRTP(2), | |
22228 | & -1,Max_pro_2,1,4,MSPOM+MHPOM) | |
22229 | XSCUT = HSig(9) | |
22230 | AHS = AH | |
22231 | ALNHS = ALNH | |
22232 | Z1DIFS = Z1DIF | |
22233 | Z2DIFS = Z2DIF | |
22234 | AH = (2.D0*PTWANT/ECMP)**2 | |
22235 | ALNH = LOG(AH) | |
22236 | Z1DIF = Z1MAX+Z2MAX-ALNH | |
22237 | Z2DIF = Z1DIF | |
22238 | IF((Z1DIF.LE.0.01D0).OR.(Z2DIF.LE.0.01D0)) THEN | |
22239 | IF(IDEB(24).GE.1) WRITE(LO,'(1X,2A,/1X,1P4E12.3)') | |
22240 | & 'PHO_POMSCA: kin.rejection, high-pt option ', | |
22241 | & '(Z1/2max,ALNH,Z1dif):',Z1MAX,Z2MAX,ALNH,Z1DIF | |
22242 | IREJ = 5 | |
22243 | RETURN | |
22244 | ENDIF | |
22245 | CALL PHO_HARSCA(2,II) | |
22246 | CALL PHO_HARINT(1,ECMP,PVIRTP(1),PVIRTP(2), | |
22247 | & -1,Max_pro_2,1,4,MSPOM+MHPOM) | |
22248 | AH = AHS | |
22249 | ALNH = ALNHS | |
22250 | Z1DIF = Z1DIFS | |
22251 | Z2DIF = Z2DIFS | |
22252 | IPOWGC(4+II) = IPOWGC(4+II)+1 | |
22253 | HSWGHT(4+II) = XSCUT/HSig(9)*DBLE(MHARD) | |
22254 | C minimum bias option | |
22255 | ELSE | |
22256 | CALL PHO_HARSCA(2,II) | |
22257 | ENDIF | |
22258 | ||
22259 | C fill /POHSLT/ | |
22260 | LSIDX(NN) = NN | |
22261 | LSCAHD = NN | |
22262 | XHD(NN,1) = X1 | |
22263 | XHD(NN,2) = X2 | |
22264 | X0HD(NN,1) = X1 | |
22265 | X0HD(NN,2) = X2 | |
22266 | VHD(NN) = V | |
22267 | ETAHD(NN,1) = ETAC | |
22268 | ETAHD(NN,2) = ETAD | |
22269 | PTHD(NN) = PT | |
22270 | NPROHD(NN) = MSPR | |
22271 | Q2SCA(NN,1) = QQPD | |
22272 | Q2SCA(NN,2) = QQPD | |
22273 | PDFVA(NN,1) = PDF1(IA) | |
22274 | PDFVA(NN,2) = PDF2(IB) | |
22275 | NINHD(NN,1) = IA | |
22276 | NINHD(NN,2) = IB | |
22277 | N0INHD(NN,1) = IA | |
22278 | N0INHD(NN,2) = IB | |
22279 | NIVAL(NN,1) = IV1 | |
22280 | NIVAL(NN,2) = IV2 | |
22281 | N0IVAL(NN,1) = IV1 | |
22282 | N0IVAL(NN,2) = IV2 | |
22283 | NOUTHD(NN,1) = IC | |
22284 | NOUTHD(NN,2) = ID | |
22285 | NBRAHD(NN,1) = IDPDG1 | |
22286 | NBRAHD(NN,2) = IDPDG2 | |
22287 | I3 = 8*(NN-1) | |
22288 | I4 = 8*(NN-1)+4 | |
22289 | DO 50 I=1,4 | |
22290 | PPH(I3+I,1) = PHI1(I) | |
22291 | PPH(I3+I,2) = PHI2(I) | |
22292 | PPH(I4+I,1) = PHO1(I) | |
22293 | PPH(I4+I,2) = PHO2(I) | |
22294 | 50 CONTINUE | |
22295 | ||
22296 | 11 CONTINUE | |
22297 | ||
22298 | C sort according to pt-hat | |
22299 | DO 12 NN=1,MHARD | |
22300 | PTMX = PTHD(LSIDX(NN)) | |
22301 | IPTM = NN | |
22302 | DO 13 I=NN+1,MHARD | |
22303 | IF(PTHD(LSIDX(I)).GT.PTMX) THEN | |
22304 | IPTM = I | |
22305 | PTMX = PTHD(LSIDX(I)) | |
22306 | ENDIF | |
22307 | 13 CONTINUE | |
22308 | IF(IPTM.NE.NN) CALL PHO_SWAPI(LSIDX(NN),LSIDX(IPTM)) | |
22309 | 12 CONTINUE | |
22310 | IPTM = LSIDX(1) | |
22311 | ||
22312 | C copy partons, generate ISR | |
22313 | DO 15 L=1,MHARD | |
22314 | NN = LSIDX(L) | |
22315 | XSSS1 = XSS1+XHD(NN,1) | |
22316 | XSSS2 = XSS2+XHD(NN,2) | |
22317 | C debug output | |
22318 | IF(IDEB(24).GE.10) WRITE(LO,'(1X,A,3I4,1P,3E11.3)') | |
22319 | & 'PHO_POMSCA: NR,LSIDX,MSPR,X1,X2,PT', | |
22320 | & L,NN,NPROHD(NN),XHD(NN,1),XHD(NN,2),PTHD(NN) | |
22321 | C check phase space | |
22322 | IF( (XSSS1.GT.XMAXX1) | |
22323 | & .OR.(XSSS2.GT.XMAXX2) | |
22324 | & .OR.((1.D0-XSSS1)*(1.D0-XSSS2).LT.AS) ) THEN | |
22325 | IF(IHARD.EQ.0) THEN | |
22326 | IF(ISWMDL(2).NE.1) GOTO 20 | |
22327 | MHPOM = 0 | |
22328 | MSPOM = 1 | |
22329 | MSREG = 0 | |
22330 | ENDIF | |
22331 | GOTO 199 | |
22332 | ENDIF | |
22333 | ||
22334 | C reweight according to photon virtuality | |
22335 | IF(IPAMDL(115).GE.1) THEN | |
22336 | QQPD = Q2SCA(NN,1) | |
22337 | WGX = 1.D0 | |
22338 | IF(IDPDG1.EQ.22) THEN | |
22339 | IF(IPAMDL(115).EQ.1) THEN | |
22340 | IF(QQPD.LT.PVIRTP(1)+PARMDL(144)) THEN | |
22341 | WG1 = 0.D0 | |
22342 | ELSE | |
22343 | WG1 = LOG(QQPD/(PVIRTP(1)+PARMDL(144))) | |
22344 | & /LOG(QQPD/PARMDL(144)) | |
22345 | ENDIF | |
22346 | IF(NINHD(NN,1).EQ.0) WG1 = WG1*WG1 | |
22347 | ELSE IF(IPAMDL(115).EQ.2) THEN | |
22348 | CALL PHO_PDF(1,X0HD(NN,1),QQPD,PVIRTP(1),PD1) | |
22349 | WG1 = PD1(NINHD(NN,1))/PDFVA(NN,1) | |
22350 | ENDIF | |
22351 | WGX = WG1 | |
22352 | ENDIF | |
22353 | QQPD = Q2SCA(NN,2) | |
22354 | IF(IDPDG2.EQ.22) THEN | |
22355 | IF(IPAMDL(115).EQ.1) THEN | |
22356 | IF(QQPD.LT.PVIRTP(2)+PARMDL(144)) THEN | |
22357 | WG1 = 0.D0 | |
22358 | ELSE | |
22359 | WG1 = LOG(QQPD/(PVIRTP(2)+PARMDL(144))) | |
22360 | & /LOG(QQPD/PARMDL(144)) | |
22361 | ENDIF | |
22362 | IF(NINHD(NN,2).EQ.0) WG1 = WG1*WG1 | |
22363 | ELSE IF(IPAMDL(115).EQ.2) THEN | |
22364 | CALL PHO_PDF(2,X0HD(NN,2),QQPD,PVIRTP(2),PD1) | |
22365 | WG1 = PD1(NINHD(NN,2))/PDFVA(NN,2) | |
22366 | ENDIF | |
22367 | WGX = WGX*WG1 | |
22368 | ENDIF | |
22369 | ||
22370 | IF(IDEB(24).GE.25) | |
22371 | & WRITE(LO,'(1X,2A,/5X,I10,I3,1P6E10.3)') 'PHO_POMSCA: ', | |
22372 | & ' re-weight with (EVE, MSPR, X1/2, Q2, PV1/2, W1/W2)', | |
22373 | & KEVENT,MSPR,X0HD(NN,1),X0HD(NN,2),QQPD,PVIRTP,WGX | |
22374 | ||
22375 | IF(WGX.LT.DT_RNDM(WGX)) THEN | |
22376 | IF(L.EQ.1) THEN | |
22377 | IREJ = 50 | |
22378 | RETURN | |
22379 | ELSE | |
22380 | GOTO 199 | |
22381 | ENDIF | |
22382 | ENDIF | |
22383 | ||
22384 | IF(WGX.GT.1.D0) WRITE(LO,'(1X,2A,/5X,I10,I3,1P6E10.3)') | |
22385 | & 'PHO_POMSCA: ', | |
22386 | & 'weight >1 (EVE, MSPR, X1/2, Q2, PV1/2, W1/W2)', | |
22387 | & KEVENT,MSPR,X0HD(NN,1),X0HD(NN,2),QQPD,PVIRTP,WGX | |
22388 | ||
22389 | ENDIF | |
22390 | ||
22391 | C generate ISR | |
22392 | IF((ISWMDL(8).GE.2) | |
22393 | & .AND.((IPAMDL(101).NE.1).OR.(L.EQ.1))) THEN | |
22394 | IF(IPAMDL(109).EQ.1) THEN | |
22395 | Q2H = PARMDL(93)*PTHD(NN)**2 | |
22396 | ELSE | |
22397 | Q2H = -PARMDL(93)*VHD(NN) | |
22398 | & *XHD(NN,1)*XHD(NN,2)*ECMP*ECMP | |
22399 | ENDIF | |
22400 | XHMAX1 = 1.D0 - XSSS1 - MSCHA*AS + XHD(NN,1) | |
22401 | XHMAX2 = 1.D0 - XSSS2 - MSCHA*AS + XHD(NN,2) | |
22402 | I3 = 8*NN-4 | |
22403 | DO 42 J=1,4 | |
22404 | P1(J) = PPH(I3+J,1) | |
22405 | P2(J) = PPH(I3+J,2) | |
22406 | 42 CONTINUE | |
22407 | IF(IDEB(24).GE.10) | |
22408 | & WRITE(LO,'(1X,A,/5X,2I3,1P,3E12.4)') | |
22409 | & 'PHO_POMSCA: generate ISR for (L,NN,X1,X2,Q2H)', | |
22410 | & L,NN,XHD(NN,1),XHD(NN,2),Q2H | |
22411 | J = NN | |
22412 | IF(L.EQ.1) J = -NN | |
22413 | CALL PHO_HARISR(J,P1,P2,NOUTHD(NN,1),NOUTHD(NN,2), | |
22414 | & N0INHD(NN,1),N0INHD(NN,2),N0IVAL(NN,1),N0IVAL(NN,2),Q2H, | |
22415 | & X0HD(NN,1),X0HD(NN,2),XHMAX1,XHMAX2,IFL1,IFL2, | |
22416 | & NIVAL(NN,1),NIVAL(NN,2),XISR1,XISR2,IREJ) | |
22417 | XSSS1 = XSSS1+XISR1-XHD(NN,1) | |
22418 | XSSS2 = XSSS2+XISR2-XHD(NN,2) | |
22419 | NINHD(NN,1) = IFL1 | |
22420 | NINHD(NN,2) = IFL2 | |
22421 | XHD(NN,1) = XISR1 | |
22422 | XHD(NN,2) = XISR2 | |
22423 | ENDIF | |
22424 | ||
22425 | C check phase space | |
22426 | IF( (XSSS1.GT.XMAXX1) | |
22427 | & .OR.(XSSS2.GT.XMAXX2) | |
22428 | & .OR.((1.D0-XSSS1)*(1.D0-XSSS2).LT.AS) ) THEN | |
22429 | IF(IHARD.EQ.0) THEN | |
22430 | IF(ISWMDL(2).NE.1) GOTO 20 | |
22431 | MHPOM = 0 | |
22432 | MSPOM = 1 | |
22433 | MSREG = 0 | |
22434 | ENDIF | |
22435 | GOTO 199 | |
22436 | ENDIF | |
22437 | ||
22438 | C leave energy for leading particle effect | |
22439 | IF((IHARD.GT.0).AND. | |
22440 | & ((XSSS1.GT.XMAXP1).OR.(XSSS2.GT.XMAXP2))) then | |
22441 | GOTO 199 | |
22442 | endif | |
22443 | ||
22444 | C hard scattering accepted | |
22445 | IHARD = IHARD+1 | |
22446 | XSS1 = XSSS1 | |
22447 | XSS2 = XSSS2 | |
22448 | IFAIL(31) = IFAIL(31)-1 | |
22449 | ||
22450 | 15 CONTINUE | |
22451 | ||
22452 | C ------------------- end of inner (hard) loop ------------------- | |
22453 | 199 CONTINUE | |
22454 | ||
22455 | MHPOM = IHARD | |
22456 | MHPAR1 = IHARD | |
22457 | MHPAR2 = IHARD | |
22458 | ||
22459 | C count valences involved in hard scattering | |
22460 | IVAL1 = 0 | |
22461 | IVAL2 = 0 | |
22462 | DO 17 L=1,IHARD | |
22463 | NN = LSIDX(L) | |
22464 | IF((NIVAL(NN,1).NE.0).AND.(IVAL1.EQ.0)) IVAL1 = NN | |
22465 | IF((NIVAL(NN,2).NE.0).AND.(IVAL2.EQ.0)) IVAL2 = NN | |
22466 | 17 CONTINUE | |
22467 | ||
22468 | IQUA1 = 0 | |
22469 | IQUA2 = 0 | |
22470 | IVGLU1 = 0 | |
22471 | IVGLU2 = 0 | |
22472 | DO 18 L=1,IHARD | |
22473 | NN = LSIDX(L) | |
22474 | ||
22475 | C photon, pomeron valences | |
22476 | IF((IVAL1.EQ.0).AND.(NINHD(NN,1).NE.0)) THEN | |
22477 | IF((IDPDG1.EQ.22).OR.(IDPDG1.EQ.990)) THEN | |
22478 | NIVAL(NN,1) = 1 | |
22479 | IVAL1 = NN | |
22480 | ENDIF | |
22481 | ENDIF | |
22482 | IF((IVAL2.EQ.0).AND.(NINHD(NN,2).NE.0)) THEN | |
22483 | IF((IDPDG2.EQ.22).OR.(IDPDG2.EQ.990)) THEN | |
22484 | NIVAL(NN,2) = 1 | |
22485 | IVAL2 = NN | |
22486 | ENDIF | |
22487 | ENDIF | |
22488 | ||
22489 | C total number of quarks | |
22490 | IF(NINHD(NN,1).NE.0) THEN | |
22491 | IQUA1 = IQUA1+1 | |
22492 | ELSE IF(IVGLU1.EQ.0) THEN | |
22493 | IVGLU1 = NN | |
22494 | ENDIF | |
22495 | IF(NINHD(NN,2).NE.0) THEN | |
22496 | IQUA2 = IQUA2+1 | |
22497 | ELSE IF(IVGLU2.EQ.0) THEN | |
22498 | IVGLU2 = NN | |
22499 | ENDIF | |
22500 | 18 CONTINUE | |
22501 | ||
22502 | C gluons emitted by valence quarks | |
22503 | VALPRO = 1.D0 | |
22504 | IF(II.EQ.1) VALPRO = VALPRG(1) | |
22505 | IVQ1 = 1 | |
22506 | IVG1 = 0 | |
22507 | IVAL1 = MAX(IVAL1,0) | |
22508 | IF(IVAL1.EQ.0) THEN | |
22509 | IVQ1 = 0 | |
22510 | IF((IVGLU1.NE.0).AND.(DT_RNDM(XSS1).LT.VALPRO)) THEN | |
22511 | IVAL1 = -IVGLU1 | |
22512 | IVG1 = 1 | |
22513 | ENDIF | |
22514 | ENDIF | |
22515 | VALPRO = 1.D0 | |
22516 | IF(II.EQ.1) VALPRO = VALPRG(2) | |
22517 | IVQ2 = 1 | |
22518 | IVG2 = 0 | |
22519 | IVAL2 = MAX(IVAL2,0) | |
22520 | IF(IVAL2.EQ.0) THEN | |
22521 | IVQ2 = 0 | |
22522 | IF((IVGLU2.NE.0).AND.(DT_RNDM(XSS2).LT.VALPRO)) THEN | |
22523 | IVAL2 = -IVGLU2 | |
22524 | IVG2 = 1 | |
22525 | ENDIF | |
22526 | ENDIF | |
22527 | MSPOM = MAX(0,MSPOM-IQUA1-IQUA2) | |
22528 | C debug output | |
22529 | IF(IDEB(24).GE.5) WRITE(LO,'(1X,A,6I4)') | |
22530 | & 'PHO_POMSCA: IVAL1/2,IQUA1/2,IVGLU1/2', | |
22531 | & IVAL1,IVAL2,IQUA1,IQUA2,IVGLU1,IVGLU2 | |
22532 | ||
22533 | C select soft X values | |
22534 | 25 CONTINUE | |
22535 | C number of soft/remnant quarks | |
22536 | IF(MSPOM.EQ.0) THEN | |
22537 | IF(IPAMDL(18).EQ.0) THEN | |
22538 | MSPAR1 = 2+2*MHPOM+MSREG-IQUA1-2*IVQ1-2*IVG1 | |
22539 | MSPAR2 = 2+2*MHPOM+MSREG-IQUA2-2*IVQ2-2*IVG2 | |
22540 | ELSE | |
22541 | MSPAR1 = 2+MSREG+IQUA1-2*IVQ1 | |
22542 | MSPAR2 = 2+MSREG+IQUA2-2*IVQ2 | |
22543 | ENDIF | |
22544 | ELSE | |
22545 | IF(IPAMDL(18).EQ.0) THEN | |
22546 | MSPAR1 = 2*MSPOM+MSREG+2*MHPOM-IQUA1 | |
22547 | MSPAR2 = 2*MSPOM+MSREG+2*MHPOM-IQUA2 | |
22548 | ELSE | |
22549 | MSPAR1 = 2*MSPOM+MSREG+IQUA1+2*IVG1 | |
22550 | MSPAR2 = 2*MSPOM+MSREG+IQUA2+2*IVG2 | |
22551 | ENDIF | |
22552 | ENDIF | |
22553 | C debug output | |
22554 | IF(IDEB(24).GE.15) WRITE(LO,'(1X,A,9I3)') | |
22555 | & 'PHO_POMSCA: MSP,MSR,MHP,IVQ1/2,IVG1/2,MSPAR1/2', | |
22556 | & MSPOM,MSREG,MHPOM,IVQ1,IVQ2,IVG1,IVG2,MSPAR1,MSPAR2 | |
22557 | ||
22558 | XMAX1 = 1.D0 - MAX(MSPAR1-1,0)*AS - XSS1 | |
22559 | XMAX2 = 1.D0 - MAX(MSPAR2-1,0)*AS - XSS2 | |
22560 | I1 = IVQ1 | |
22561 | I2 = IVQ2 | |
22562 | IF(IVAL1.LE.0) I1 = 0 | |
22563 | IF(IVAL2.LE.0) I2 = 0 | |
22564 | IF((IVQ1+IVG1)*(IVQ2+IVG2).NE.0) THEN | |
22565 | MSDIFF = 2*MSPOM | |
22566 | ELSE | |
22567 | MSDIFF = 2*MAX(0,MSPOM-1) | |
22568 | ENDIF | |
22569 | MSG1 = MSPAR1 | |
22570 | MSG2 = MSPAR2 | |
22571 | MSM1 = MSPAR1-MSDIFF | |
22572 | MSM2 = MSPAR2-MSDIFF | |
22573 | XMAXH1 = MIN(XMAX1,PARMDL(44)) | |
22574 | XMAXH2 = MIN(XMAX2,PARMDL(44)) | |
22575 | CALL PHO_SOFTXX(NPOSP(1),NPOSP(2),MSG1,MSG2,I1,I2,MSM1,MSM2, | |
22576 | & XSS1,XSS2,XMAXH1,XMAXH2,XS1,XS2,IREJ) | |
22577 | ||
22578 | C correct for proper simulation of high pt tail | |
22579 | IF(IREJ.NE.0) THEN | |
22580 | IF(IDEB(48).GE.2) WRITE(LO,'(1X,A,4I4)') | |
22581 | & 'PHO_STDPAR: rejection (PHO_SOFTXX): MSPOM,MHPOM,I1,I2', | |
22582 | & MSPOM,MHPOM,I1,I2 | |
22583 | IF(MSPOM*MHPOM.GT.0) THEN | |
22584 | MSPOM = MSPOM-1 | |
22585 | GOTO 25 | |
22586 | ELSE IF(MSPOM.GT.1) THEN | |
22587 | MSPOM = MSPOM-1 | |
22588 | GOTO 25 | |
22589 | ELSE IF(MHPOM.GT.1) THEN | |
22590 | IHARD = IHARD-1 | |
22591 | IF((IPAMDL(13).GT.0).AND.(IPOIX3.EQ.0) | |
22592 | & .AND.(IPROCE.EQ.1)) THEN | |
22593 | XSS1 = MAX(0.D0,1.D0-XPSUB) | |
22594 | XSS2 = MAX(0.D0,1.D0-XTSUB) | |
22595 | ELSE | |
22596 | XSS1 = 0.D0 | |
22597 | XSS2 = 0.D0 | |
22598 | ENDIF | |
22599 | DO 103 K=1,IHARD | |
22600 | I = LSIDX(K) | |
22601 | XSS1 = XSS1+ XHD(I,1) | |
22602 | XSS2 = XSS2+ XHD(I,2) | |
22603 | 103 CONTINUE | |
22604 | GOTO 199 | |
22605 | ENDIF | |
22606 | IREJ = 4 | |
22607 | GOTO 450 | |
22608 | ENDIF | |
22609 | C accepted | |
22610 | MSPOM = MSPOM-(MSPAR1-MSG1)/2 | |
22611 | MSPAR1 = MSG1 | |
22612 | MSPAR2 = MSG2 | |
22613 | C ------------ kinematics sampled --------------- | |
22614 | C debug output | |
22615 | IF(IDEB(24).GE.10) THEN | |
22616 | WRITE(LO,'(1X,A,I3)') | |
22617 | & 'PHO_POMSCA: soft x values, ITRY',ITRY | |
22618 | DO 104 I=2,MAX(MSPAR1,MSPAR2) | |
22619 | WRITE(LO,'(10X,I3,2E12.3)') I,XS1(I),XS2(I) | |
22620 | 104 CONTINUE | |
22621 | ENDIF | |
22622 | IF((1.D0-XSS1)*(1.D0-XSS2).LT.AS) GOTO 20 | |
22623 | ||
22624 | C end of loop | |
22625 | XS1(1) = 1.D0 - XSS1 | |
22626 | XS2(1) = 1.D0 - XSS2 | |
22627 | ||
22628 | C process counting | |
22629 | DO 30 N=1,LSCAHD | |
22630 | MH_acc_1(NPROHD(N),II) = MH_acc_1(NPROHD(N),II)+1 | |
22631 | 30 CONTINUE | |
22632 | ||
22633 | C soft particle momenta | |
22634 | IF(MAX(MSPAR1,MSPAR2).GT.MAXSOF) THEN | |
22635 | WRITE(LO,'(1X,2A,3I4)') 'PHO_POMSCA: no space left in ', | |
22636 | & '/POSOFT/ (MSPAR1/2,MAXSOF):',MSPAR1,MSPAR2,MAXSOF | |
22637 | IREJ = 1 | |
22638 | RETURN | |
22639 | ENDIF | |
22640 | DO 55 I=1,MSPAR1 | |
22641 | PSOFT1(1,I) = 0.D0 | |
22642 | PSOFT1(2,I) = 0.D0 | |
22643 | PSOFT1(3,I) = XS1(I)*ECMP/2.D0 | |
22644 | PSOFT1(4,I) = XS1(I)*ECMP/2.D0 | |
22645 | 55 CONTINUE | |
22646 | DO 60 I=1,MSPAR2 | |
22647 | PSOFT2(1,I) = 0.D0 | |
22648 | PSOFT2(2,I) = 0.D0 | |
22649 | PSOFT2(3,I) = -XS2(I)*ECMP/2.D0 | |
22650 | PSOFT2(4,I) = XS2(I)*ECMP/2.D0 | |
22651 | 60 CONTINUE | |
22652 | ||
22653 | KSOFT = MAX(MSPAR1,MSPAR2) | |
22654 | KHARD = MAX(MHPAR1,MHPAR2) | |
22655 | KSPOM = MSPOM | |
22656 | KSREG = MSREG | |
22657 | KHPOM = MHPOM | |
22658 | ||
22659 | C debug output | |
22660 | IF(IDEB(24).GE.10) THEN | |
22661 | WRITE(LO,'(/1X,A,2I3,2I5)') | |
22662 | & 'PHO_POMSCA: accepted IVAL1,IVAL2,ITRY,NTRY', | |
22663 | & IVAL1,IVAL2,ITRY,NTRY | |
22664 | IF(MSPAR1+MSPAR2.GT.0) THEN | |
22665 | WRITE(LO,'(5X,A)') 'soft x particle1 particle2:' | |
22666 | XTMP1 = 0.D0 | |
22667 | XTMP2 = 0.D0 | |
22668 | DO 105 I=1,MAX(MSPAR1,MSPAR2) | |
22669 | IF(I.LE.MIN(MSPAR1,MSPAR2)) THEN | |
22670 | WRITE(LO,'(10X,I3,2E13.4)') I,XS1(I),XS2(I) | |
22671 | XTMP1 = XTMP1+XS1(I) | |
22672 | XTMP2 = XTMP2+XS2(I) | |
22673 | ELSE IF(I.LE.MSPAR1) THEN | |
22674 | WRITE(LO,'(10X,I3,2E13.4)') I,XS1(I),0.D0 | |
22675 | XTMP1 = XTMP1+XS1(I) | |
22676 | ELSE IF(I.LE.MSPAR2) THEN | |
22677 | WRITE(LO,'(10X,I3,2E13.4)') I,0.D0,XS2(I) | |
22678 | XTMP2 = XTMP2+XS2(I) | |
22679 | ENDIF | |
22680 | 105 CONTINUE | |
22681 | WRITE(LO,'(5X,A,2E13.4)') 'sum X1/2 (soft):',XTMP1,XTMP2 | |
22682 | ENDIF | |
22683 | IF(MHPAR1.GT.0) THEN | |
22684 | WRITE(LO,'(5X,A)') | |
22685 | & 'NR IDX MSPR hard X / hard X ISR / flavor particle 1,2:' | |
22686 | DO 107 K=1,MHPAR1 | |
22687 | I = LSIDX(K) | |
22688 | WRITE(LO,'(5X,3I3,4E12.3,2I3)') | |
22689 | & K,I,NPROHD(I),X0HD(I,1),X0HD(I,2),XHD(I,1),XHD(I,2), | |
22690 | & NINHD(I,1),NINHD(I,2) | |
22691 | XTMP1 = XTMP1+XHD(I,1) | |
22692 | XTMP2 = XTMP2+XHD(I,2) | |
22693 | 107 CONTINUE | |
22694 | WRITE(LO,'(1X,A,2E13.4)') 'sum X1/2 (soft+hard):',XTMP1,XTMP2 | |
22695 | WRITE(LO,'(5X,A)') 'hard momenta particle1:' | |
22696 | DO 108 K=1,MHPAR1 | |
22697 | I = LSIDX(K) | |
22698 | I3 = 8*I-4 | |
22699 | WRITE(LO,'(5X,2I3,1P,4E12.3,I5)') K,I,(PPH(I3+L,1),L=1,4), | |
22700 | & NOUTHD(I,1) | |
22701 | 108 CONTINUE | |
22702 | WRITE(LO,'(5X,A)') 'hard momenta particle2:' | |
22703 | DO 110 K=1,MHPAR2 | |
22704 | I = LSIDX(K) | |
22705 | I3 = 8*I-4 | |
22706 | WRITE(LO,'(5X,2I3,1P,4E12.3,I5)') K,I,(PPH(I3+L,2),L=1,4), | |
22707 | & NOUTHD(I,2) | |
22708 | 110 CONTINUE | |
22709 | ENDIF | |
22710 | ENDIF | |
22711 | RETURN | |
22712 | ||
22713 | C event rejected, print debug information | |
22714 | 450 CONTINUE | |
22715 | IFAIL(4) = IFAIL(4)+1 | |
22716 | IF(IDEB(24).GE.2) THEN | |
22717 | WRITE(LO,'(1X,2A,/,10X,7I5)') 'PHO_POMSCA: ', | |
22718 | & 'rejection (MSPOM,MHPOM,IHARD,MHARD,ITRY,NTRY,IREJ)', | |
22719 | & MSPOM,MHPOM,IHARD,MHARD,ITRY,NTRY,IREJ | |
22720 | WRITE(LO,'(5X,A,I4,1P,2E12.4)') 'IP,Ecm,PTcut:',II,ECMP,PTWANT | |
22721 | IF(IDEB(24).GE.5) THEN | |
22722 | CALL PHO_PREVNT(0) | |
22723 | ELSE | |
22724 | CALL PHO_PREVNT(-1) | |
22725 | ENDIF | |
22726 | ENDIF | |
22727 | ||
22728 | END | |
22729 | ||
22730 | *$ CREATE PHO_HARX12.FOR | |
22731 | *COPY PHO_HARX12 | |
22732 | CDECK ID>, PHO_HARX12 | |
22733 | SUBROUTINE PHO_HARX12 | |
22734 | C********************************************************************** | |
22735 | C | |
22736 | C selection of x1 and x2 according to 1/x1*1/x2 | |
22737 | C | |
22738 | C********************************************************************** | |
22739 | IMPLICIT DOUBLE PRECISION (A-H,O-Z) | |
22740 | SAVE | |
22741 | ||
22742 | PARAMETER ( TINY= 1.D-30, TINY6=1.D-06) | |
22743 | ||
22744 | C input/output channels | |
22745 | INTEGER LI,LO | |
22746 | COMMON /POINOU/ LI,LO | |
22747 | C data on most recent hard scattering | |
22748 | INTEGER IA,IB,IC,ID,IV1,IV2,MSPR,IREJSC | |
22749 | DOUBLE PRECISION PTWANT,AS,AH,ALNS,ALNH,Z1MAX,Z1DIF,Z2MAX,Z2DIF, | |
22750 | & PT,PTfin,ETAC,ETAD,X1,X2,V,U,W,W1,AXX,QQPD,QQAL, | |
22751 | & PDF1,PDF2,WEIGHT,PHI1,PHI2,PHO1,PHO2 | |
22752 | COMMON /POCKIN/ PTWANT,AS,AH,ALNS,ALNH,Z1MAX,Z1DIF,Z2MAX,Z2DIF, | |
22753 | & PT,PTfin,ETAC,ETAD,X1,X2,V,U,W,W1,AXX, | |
22754 | & QQPD,QQAL,PDF1(-6:6),PDF2(-6:6),WEIGHT, | |
22755 | & PHI1(5),PHI2(5),PHO1(5),PHO2(5), | |
22756 | & IA,IB,IC,ID,IV1,IV2,MSPR,IREJSC | |
22757 | ||
22758 | 10 CONTINUE | |
22759 | Z1 = Z1MAX-DT_RNDM(X1)*Z1DIF | |
22760 | Z2 = Z2MAX-DT_RNDM(X2)*Z2DIF | |
22761 | IF ( (Z1+Z2).LT.ALNH ) GOTO 10 | |
22762 | X1 = EXP(Z1) | |
22763 | X2 = EXP(Z2) | |
22764 | AXX = AH/(X1*X2) | |
22765 | W = SQRT(MAX(TINY,1.D0-AXX)) | |
22766 | W1 = AXX/(1.D0+W) | |
22767 | ||
22768 | END | |
22769 | ||
22770 | *$ CREATE PHO_HARDX1.FOR | |
22771 | *COPY PHO_HARDX1 | |
22772 | CDECK ID>, PHO_HARDX1 | |
22773 | SUBROUTINE PHO_HARDX1 | |
22774 | C********************************************************************** | |
22775 | C | |
22776 | C selection of x1 according to 1/x1 | |
22777 | C ( x2 = 1 ) | |
22778 | C | |
22779 | C********************************************************************** | |
22780 | IMPLICIT DOUBLE PRECISION (A-H,O-Z) | |
22781 | SAVE | |
22782 | ||
22783 | PARAMETER ( TINY= 1.D-30, TINY6=1.D-06) | |
22784 | ||
22785 | C input/output channels | |
22786 | INTEGER LI,LO | |
22787 | COMMON /POINOU/ LI,LO | |
22788 | C data on most recent hard scattering | |
22789 | INTEGER IA,IB,IC,ID,IV1,IV2,MSPR,IREJSC | |
22790 | DOUBLE PRECISION PTWANT,AS,AH,ALNS,ALNH,Z1MAX,Z1DIF,Z2MAX,Z2DIF, | |
22791 | & PT,PTfin,ETAC,ETAD,X1,X2,V,U,W,W1,AXX,QQPD,QQAL, | |
22792 | & PDF1,PDF2,WEIGHT,PHI1,PHI2,PHO1,PHO2 | |
22793 | COMMON /POCKIN/ PTWANT,AS,AH,ALNS,ALNH,Z1MAX,Z1DIF,Z2MAX,Z2DIF, | |
22794 | & PT,PTfin,ETAC,ETAD,X1,X2,V,U,W,W1,AXX, | |
22795 | & QQPD,QQAL,PDF1(-6:6),PDF2(-6:6),WEIGHT, | |
22796 | & PHI1(5),PHI2(5),PHO1(5),PHO2(5), | |
22797 | & IA,IB,IC,ID,IV1,IV2,MSPR,IREJSC | |
22798 | ||
22799 | Z1 = Z1MAX-DT_RNDM(X1)*Z1DIF | |
22800 | X2 = 1.D0 | |
22801 | X1 = EXP(Z1) | |
22802 | AXX = AH/X1 | |
22803 | W = SQRT(MAX(TINY,1.D0-AXX)) | |
22804 | W1 = AXX/(1.D0+W) | |
22805 | ||
22806 | END | |
22807 | ||
22808 | *$ CREATE PHO_HARKIN.FOR | |
22809 | *COPY PHO_HARKIN | |
22810 | CDECK ID>, PHO_HARKIN | |
22811 | SUBROUTINE PHO_HARKIN(IREJ) | |
22812 | C*********************************************************************** | |
22813 | C | |
22814 | C selection of kinematic variables | |
22815 | C (resolved and direct processes) | |
22816 | C | |
22817 | C*********************************************************************** | |
22818 | IMPLICIT DOUBLE PRECISION (A-H,O-Z) | |
22819 | SAVE | |
22820 | ||
22821 | PARAMETER ( TINY= 1.D-30, TINYP=1.D-14 ) | |
22822 | ||
22823 | C input/output channels | |
22824 | INTEGER LI,LO | |
22825 | COMMON /POINOU/ LI,LO | |
22826 | C event debugging information | |
22827 | INTEGER NMAXD | |
22828 | PARAMETER (NMAXD=100) | |
22829 | INTEGER IDEB,KSPOM,KHPOM,KSREG,KHDIR,KACCEP,KSTRG,KHTRG,KSLOO, | |
22830 | & KHLOO,KSDPO,KHDPO,KEVENT,KSOFT,KHARD | |
22831 | COMMON /PODEBG/ IDEB(NMAXD),KSPOM,KHPOM,KSREG,KHDIR,KACCEP,KSTRG, | |
22832 | & KHTRG,KSLOO,KHLOO,KSDPO,KHDPO,KEVENT,KSOFT,KHARD | |
22833 | C data of c.m. system of Pomeron / Reggeon exchange | |
22834 | INTEGER NPOSP,IDPDG1,IDBAM1,IDPDG2,IDBAM2 | |
22835 | DOUBLE PRECISION ECMP,PCMP,PMASSP,PVIRTP,GAMBEP, | |
22836 | & SIDP,CODP,SIFP,COFP | |
22837 | COMMON /POPCMS/ ECMP,PCMP,PMASSP(2),PVIRTP(2),GAMBEP(4), | |
22838 | & SIDP,CODP,SIFP,COFP,NPOSP(2), | |
22839 | & IDPDG1,IDBAM1,IDPDG2,IDBAM2 | |
22840 | C data on most recent hard scattering | |
22841 | INTEGER IA,IB,IC,ID,IV1,IV2,MSPR,IREJSC | |
22842 | DOUBLE PRECISION PTWANT,AS,AH,ALNS,ALNH,Z1MAX,Z1DIF,Z2MAX,Z2DIF, | |
22843 | & PT,PTfin,ETAC,ETAD,X1,X2,V,U,W,W1,AXX,QQPD,QQAL, | |
22844 | & PDF1,PDF2,WEIGHT,PHI1,PHI2,PHO1,PHO2 | |
22845 | COMMON /POCKIN/ PTWANT,AS,AH,ALNS,ALNH,Z1MAX,Z1DIF,Z2MAX,Z2DIF, | |
22846 | & PT,PTfin,ETAC,ETAD,X1,X2,V,U,W,W1,AXX, | |
22847 | & QQPD,QQAL,PDF1(-6:6),PDF2(-6:6),WEIGHT, | |
22848 | & PHI1(5),PHI2(5),PHO1(5),PHO2(5), | |
22849 | & IA,IB,IC,ID,IV1,IV2,MSPR,IREJSC | |
22850 | C internal cross check information on hard scattering limits | |
22851 | DOUBLE PRECISION ETAMI,ETAMA,XXMI,XXMA | |
22852 | COMMON /POHLIM/ ETAMI(2,15),ETAMA(2,15),XXMI(2,15),XXMA(2,15) | |
22853 | ||
22854 | PARAMETER ( Max_pro_2 = 16 ) | |
22855 | DIMENSION RM(-1:Max_pro_2) | |
22856 | DATA RM / 3.31D0, 0.0D0, | |
22857 | & 7.60D0, 0.65D0, 4.00D0, 0.65D0, 0.89D0, | |
22858 | & 0.45D0, 0.89D0, 0.89D0, 0.0D0, 4.776D0, | |
22859 | & 0.615D0,4.776D0,0.615D0,1.0D0, 0.0D0, | |
22860 | & 1.0D0 / | |
22861 | ||
22862 | IREJ = 0 | |
22863 | M = MSPR | |
22864 | ||
22865 | C------------- resolved processes ----------- | |
22866 | IF ( M.EQ.1 ) THEN | |
22867 | 10 CALL PHO_HARX12 | |
22868 | V =-0.5D0*W1/(W1+DT_RNDM(X1)*W) | |
22869 | U =-1.D0-V | |
22870 | R = (1.D0+W)*2.25D0*(V*V*(3.D0-U*V-V/(U*U))-U) | |
22871 | IF(R*W.GT.RM(M)) WRITE(LO,'(1X,A,I3)') | |
22872 | & 'PHO_HARKIN:weight error',M | |
22873 | IF ( R*W.LT.RM(1)*DT_RNDM(X2) ) GOTO 10 | |
22874 | IF ( DT_RNDM(V).LE.0.5D0 ) V = U | |
22875 | ELSEIF ( M.EQ.2 .OR. M.EQ.4 ) THEN | |
22876 | 20 CALL PHO_HARX12 | |
22877 | WL = LOG(W1) | |
22878 | V =-EXP(-0.6931472D0+DT_RNDM(X1)*WL) | |
22879 | U =-1.D0-V | |
22880 | R = (U*U+V*V)*((16.D0/27.D0)/U-(4.D0/3.D0)*V)*(WL/W)*AXX | |
22881 | IF(R*W.GT.RM(M)) WRITE(LO,'(1X,A,I3)') | |
22882 | & 'PHO_HARKIN:weight error',M | |
22883 | IF ( R*W.LT.RM(M)*DT_RNDM(X2) ) GOTO 20 | |
22884 | IF ( DT_RNDM(V).LE.0.5D0 ) V = U | |
22885 | ELSEIF ( M.EQ.3 ) THEN | |
22886 | 30 CALL PHO_HARX12 | |
22887 | V =-0.5D0*W1/(W1+DT_RNDM(X1)*W) | |
22888 | U =-1.D0-V | |
22889 | R = (1.D0+W)*(1.D0+U*U)*(1.D0-(4.D0/9.D0)*V*V/U) | |
22890 | IF(R*W.GT.RM(M)) WRITE(LO,'(1X,A,I3)') | |
22891 | & 'PHO_HARKIN:weight error',M | |
22892 | IF ( R*W.LT.RM(3)*DT_RNDM(X2) ) GOTO 30 | |
22893 | ELSEIF ( M.EQ.5 ) THEN | |
22894 | 50 CALL PHO_HARX12 | |
22895 | V =-0.5D0*AXX/(W1+2.D0*DT_RNDM(X1)*W) | |
22896 | U =-1.D0-V | |
22897 | R = (4.D0/9.D0)*(1.D0+U*U+V*V*(U*U+V*V))-(8.D0/27.D0)*U*U*V | |
22898 | IF(R*W.GT.RM(M)) WRITE(LO,'(1X,A,I3)') | |
22899 | & 'PHO_HARKIN:weight error',M | |
22900 | IF ( R*W.LT.RM(5)*DT_RNDM(X2) ) GOTO 50 | |
22901 | ELSEIF ( M.EQ.6 ) THEN | |
22902 | 60 CALL PHO_HARX12 | |
22903 | V =-0.5D0*(1.D0+W)+DT_RNDM(X1)*W | |
22904 | U =-1.D0-V | |
22905 | R = (4.D0/9.D0)*(U*U+V*V)*AXX | |
22906 | IF(R*W.GT.RM(M)) WRITE(LO,'(1X,A,I3)') | |
22907 | & 'PHO_HARKIN:weight error',M | |
22908 | IF ( R*W.LT.RM(6)*DT_RNDM(V) ) GOTO 60 | |
22909 | ELSEIF ( M.EQ.7 ) THEN | |
22910 | 70 CALL PHO_HARX12 | |
22911 | V =-0.5D0*W1/(W1+DT_RNDM(X1)*W) | |
22912 | U =-1.D0-V | |
22913 | R = (1.D0+W)*((2.D0/9.D0)*(1.D0+U*U+(1.D0+V*V)*V*V/(U*U)) | |
22914 | & -(4.D0/27.D0)*V/U) | |
22915 | IF(R*W.GT.RM(M)) WRITE(LO,'(1X,A,I3)') | |
22916 | & 'PHO_HARKIN:weight error',M | |
22917 | IF ( R*W.LT.RM(7)*DT_RNDM(X2) ) GOTO 70 | |
22918 | IF ( DT_RNDM(V).LE.0.5D0 ) V = U | |
22919 | ELSEIF ( M.EQ.8 ) THEN | |
22920 | 80 CALL PHO_HARX12 | |
22921 | V =-0.5D0*AXX/(W1+2.D0*DT_RNDM(X1)*W) | |
22922 | U =-1.D0-V | |
22923 | R = (4.D0/9.D0)*(1.D0+U*U) | |
22924 | IF(R*W.GT.RM(M)) WRITE(LO,'(1X,A,I3)') | |
22925 | & 'PHO_HARKIN:weight error',M | |
22926 | IF ( R*W.LT.RM(8)*DT_RNDM(X2) ) GOTO 80 | |
22927 | ELSEIF ( M.EQ.-1 ) THEN | |
22928 | 90 CALL PHO_HARX12 | |
22929 | WL = LOG(W1) | |
22930 | V =-EXP(-0.6931472D0+DT_RNDM(X1)*WL) | |
22931 | U =-1.D0-V | |
22932 | R = (1.D0+V*V)*(V/(U*U)-(4.D0/9.D0))*(WL/W)*AXX | |
22933 | IF(R*W.GT.RM(M)) WRITE(LO,'(1X,A,I3)') | |
22934 | & 'PHO_HARKIN:weight error',M | |
22935 | IF ( R*W.LT.RM(-1)*DT_RNDM(X2) ) GOTO 90 | |
22936 | C------------- direct / single-resolved processes ----------- | |
22937 | ELSEIF ( M.EQ.10 ) THEN | |
22938 | 100 CALL PHO_HARDX1 | |
22939 | WL = LOG(AXX/(1.D0+W)**2) | |
22940 | U =-(1.D0+W)/2.D0*EXP(DT_RNDM(X1)*WL) | |
22941 | R = -(8.D0/3.D0)*(U*U+1.D0)*WL*AXX | |
22942 | IF(R.GT.RM(M)) WRITE(LO,'(1X,A,I3)') | |
22943 | & 'PHO_HARKIN:weight error',M | |
22944 | IF ( R.LT.RM(10)*DT_RNDM(U) ) GOTO 100 | |
22945 | V =-1.D0-U | |
22946 | X2 = X1 | |
22947 | X1 = 1.D0 | |
22948 | ELSEIF ( M.EQ.11) THEN | |
22949 | 110 CALL PHO_HARDX1 | |
22950 | WL = LOG(W1) | |
22951 | U =-EXP(-0.6931472D0+DT_RNDM(X1)*WL) | |
22952 | V =-1.D0-U | |
22953 | R = (U*U+V*V)/V*WL*AXX | |
22954 | IF(R.GT.RM(M)) WRITE(LO,'(1X,A,I3)') | |
22955 | & 'PHO_HARKIN:weight error',M | |
22956 | IF ( R.LT.RM(11)*DT_RNDM(X2) ) GOTO 110 | |
22957 | IF ( DT_RNDM(V).LE.0.5D0 ) V = U | |
22958 | X2 = X1 | |
22959 | X1 = 1.D0 | |
22960 | ELSEIF ( M.EQ.12 ) THEN | |
22961 | 120 CALL PHO_HARDX1 | |
22962 | WL = LOG(AXX/(1.D0+W)**2) | |
22963 | V =-(1.D0+W)/2.D0*EXP(DT_RNDM(X1)*WL) | |
22964 | R = -(8.D0/3.D0)*(V*V+1.D0)*WL*AXX | |
22965 | IF(R.GT.RM(M)) WRITE(LO,'(1X,A,I3)') | |
22966 | & 'PHO_HARKIN:weight error',M | |
22967 | IF ( R.LT.RM(12)*DT_RNDM(V) ) GOTO 120 | |
22968 | ELSEIF ( M.EQ.13) THEN | |
22969 | 130 CALL PHO_HARDX1 | |
22970 | WL = LOG(W1) | |
22971 | V =-EXP(-0.6931472D0+DT_RNDM(X1)*WL) | |
22972 | U =-1.D0-V | |
22973 | R = (U*U+V*V)/U*WL*AXX | |
22974 | IF(R.GT.RM(M)) WRITE(LO,'(1X,A,I3)') | |
22975 | & 'PHO_HARKIN:weight error',M | |
22976 | IF ( R.LT.RM(13)*DT_RNDM(X2) ) GOTO 130 | |
22977 | IF ( DT_RNDM(V).LE.0.5D0 ) V = U | |
22978 | C------------- (double) direct process ----------- | |
22979 | ELSEIF ((M.EQ.14).OR.(M.EQ.16)) THEN | |
22980 | X1 = 1.D0 | |
22981 | X2 = 1.D0 | |
22982 | AXX= AH | |
22983 | W = SQRT(MAX(TINY,1.D0-AXX)) | |
22984 | W1 = AXX/(1.D0+W) | |
22985 | WL = LOG(W1) | |
22986 | 140 V =-EXP(-0.6931472D0+DT_RNDM(X1)*WL) | |
22987 | U =-1.D0-V | |
22988 | R = -(U*U+V*V)/U | |
22989 | IF(R.GT.RM(M)) WRITE(LO,'(1X,A,I3)') | |
22990 | & 'PHO_HARKIN:weight error',M | |
22991 | IF ( R.LT.RM(14)*DT_RNDM(X2) ) GOTO 140 | |
22992 | IF ( DT_RNDM(V).LE.0.5D0 ) V = U | |
22993 | C--------------------------------------------- | |
22994 | ELSE | |
22995 | WRITE(LO,'(/1X,A,I3)') | |
22996 | & 'PHO_HARKIN:ERROR:unsupported process (MSPR)',MSPR | |
22997 | CALL PHO_ABORT | |
22998 | ENDIF | |
22999 | ||
23000 | V = MAX(MIN(V,-TINYP ),-1.D0+TINYP) | |
23001 | U = -1.D0-V | |
23002 | U = MAX(MIN(U,-TINYP ),-1.D0+TINYP) | |
23003 | PT = SQRT(U*V*X1*X2)*ECMP | |
23004 | ETAC = 0.5D0*LOG((U*X1)/(V*X2)) | |
23005 | ETAD = 0.5D0*LOG((V*X1)/(U*X2)) | |
23006 | ||
23007 | *************************************************************** | |
23008 | MM = M | |
23009 | IF(M.EQ.-1) MM = 3 | |
23010 | ETAMI(1,MM) = MIN(ETAMI(1,MM),ETAC) | |
23011 | ETAMA(1,MM) = MAX(ETAMA(1,MM),ETAC) | |
23012 | ETAMI(2,MM) = MIN(ETAMI(2,MM),ETAD) | |
23013 | ETAMA(2,MM) = MAX(ETAMA(2,MM),ETAD) | |
23014 | XXMI(1,MM) = MIN(XXMI(1,MM),X1) | |
23015 | XXMA(1,MM) = MAX(XXMA(1,MM),X1) | |
23016 | XXMI(2,MM) = MIN(XXMI(2,MM),X2) | |
23017 | XXMA(2,MM) = MAX(XXMA(2,MM),X2) | |
23018 | *************************************************************** | |
23019 | ||
23020 | IF(IDEB(81).GE.25) WRITE(LO,'(1X,A,/5X,6E12.3)') | |
23021 | & 'PHO_HARKIN: V,PT,ETAC,ETAD,X1,X2',V,PT,ETAC,ETAD,X1,X2 | |
23022 | ||
23023 | END | |
23024 | ||
23025 | *$ CREATE PHO_HARWGH.FOR | |
23026 | *COPY PHO_HARWGH | |
23027 | CDECK ID>, PHO_HARWGH | |
23028 | SUBROUTINE PHO_HARWGH(PDS,PDA,PDB,FDISTR) | |
23029 | C*********************************************************************** | |
23030 | C | |
23031 | C calculate product of PDFs and coupling constants | |
23032 | C according to selected MSPR (process type) | |
23033 | C | |
23034 | C input: /POCKIN/ | |
23035 | C | |
23036 | C output: PDS resulting from PDFs alone | |
23037 | C FDISTR complete weight function | |
23038 | C PDA,PDB fields containing the PDFs | |
23039 | C | |
23040 | C*********************************************************************** | |
23041 | IMPLICIT DOUBLE PRECISION (A-H,O-Z) | |
23042 | SAVE | |
23043 | ||
23044 | PARAMETER ( TINY= 1.D-30, TINY6=1.D-06) | |
23045 | ||
23046 | C input/output channels | |
23047 | INTEGER LI,LO | |
23048 | COMMON /POINOU/ LI,LO | |
23049 | C event debugging information | |
23050 | INTEGER NMAXD | |
23051 | PARAMETER (NMAXD=100) | |
23052 | INTEGER IDEB,KSPOM,KHPOM,KSREG,KHDIR,KACCEP,KSTRG,KHTRG,KSLOO, | |
23053 | & KHLOO,KSDPO,KHDPO,KEVENT,KSOFT,KHARD | |
23054 | COMMON /PODEBG/ IDEB(NMAXD),KSPOM,KHPOM,KSREG,KHDIR,KACCEP,KSTRG, | |
23055 | & KHTRG,KSLOO,KHLOO,KSDPO,KHDPO,KEVENT,KSOFT,KHARD | |
23056 | C model switches and parameters | |
23057 | CHARACTER*8 MDLNA | |
23058 | INTEGER ISWMDL,IPAMDL | |
23059 | DOUBLE PRECISION PARMDL | |
23060 | COMMON /POMDLS/ MDLNA(50),ISWMDL(50),PARMDL(400),IPAMDL(400) | |
23061 | C data of c.m. system of Pomeron / Reggeon exchange | |
23062 | INTEGER NPOSP,IDPDG1,IDBAM1,IDPDG2,IDBAM2 | |
23063 | DOUBLE PRECISION ECMP,PCMP,PMASSP,PVIRTP,GAMBEP, | |
23064 | & SIDP,CODP,SIFP,COFP | |
23065 | COMMON /POPCMS/ ECMP,PCMP,PMASSP(2),PVIRTP(2),GAMBEP(4), | |
23066 | & SIDP,CODP,SIFP,COFP,NPOSP(2), | |
23067 | & IDPDG1,IDBAM1,IDPDG2,IDBAM2 | |
23068 | C currently activated parton density parametrizations | |
23069 | CHARACTER*8 PDFNAM | |
23070 | INTEGER IPARID,IPAVA,ITYPE,IGRP,ISET,IEXT,NPAOLD | |
23071 | DOUBLE PRECISION PDFLAM,PDFQ2M | |
23072 | COMMON /POPPDF/ PDFLAM(2),PDFQ2M(2),PDFNAM(2),IPARID(2), | |
23073 | & IPAVA(2),ITYPE(2),IGRP(2),ISET(2),IEXT(2),NPAOLD | |
23074 | C hard scattering parameters used for most recent hard interaction | |
23075 | INTEGER NFbeta,NF | |
23076 | DOUBLE PRECISION ALQCD2,BQCD | |
23077 | COMMON /POHAPA/ ALQCD2(3,4),BQCD(4),NFbeta,NF | |
23078 | C some hadron information, will be deleted in future versions | |
23079 | INTEGER NFS | |
23080 | DOUBLE PRECISION QMASS,BET,PCOUDI,PNORM,VALPRG | |
23081 | COMMON /POHDRN/ QMASS(6),BET,PCOUDI,PNORM,VALPRG(2),NFS | |
23082 | C scale parameters for parton model calculations | |
23083 | INTEGER NQQAL,NQQALI,NQQALF,NQQPD | |
23084 | DOUBLE PRECISION AQQAL,AQQALI,AQQALF,AQQPD | |
23085 | COMMON /POHSCL/ AQQAL,AQQALI,AQQALF,AQQPD, | |
23086 | & NQQAL,NQQALI,NQQALF,NQQPD | |
23087 | C data on most recent hard scattering | |
23088 | INTEGER IA,IB,IC,ID,IV1,IV2,MSPR,IREJSC | |
23089 | DOUBLE PRECISION PTWANT,AS,AH,ALNS,ALNH,Z1MAX,Z1DIF,Z2MAX,Z2DIF, | |
23090 | & PT,PTfin,ETAC,ETAD,X1,X2,V,U,W,W1,AXX,QQPD,QQAL, | |
23091 | & PDF1,PDF2,WEIGHT,PHI1,PHI2,PHO1,PHO2 | |
23092 | COMMON /POCKIN/ PTWANT,AS,AH,ALNS,ALNH,Z1MAX,Z1DIF,Z2MAX,Z2DIF, | |
23093 | & PT,PTfin,ETAC,ETAD,X1,X2,V,U,W,W1,AXX, | |
23094 | & QQPD,QQAL,PDF1(-6:6),PDF2(-6:6),WEIGHT, | |
23095 | & PHI1(5),PHI2(5),PHO1(5),PHO2(5), | |
23096 | & IA,IB,IC,ID,IV1,IV2,MSPR,IREJSC | |
23097 | C hard cross sections and MC selection weights | |
23098 | INTEGER Max_pro_2 | |
23099 | PARAMETER ( Max_pro_2 = 16 ) | |
23100 | INTEGER IHa_last,IHb_last,MH_pro_on,MH_tried, | |
23101 | & MH_acc_1,MH_acc_2 | |
23102 | DOUBLE PRECISION Hfac,HWgx,HSig,Hdpt,HEcm_last,HQ2a_last,HQ2b_last | |
23103 | COMMON /POHRCS/ Hfac(-1:Max_pro_2),HWgx(-1:Max_pro_2), | |
23104 | & HSig(-1:Max_pro_2),Hdpt(-1:Max_pro_2), | |
23105 | & HEcm_last,HQ2a_last,HQ2b_last,IHa_last,IHb_last, | |
23106 | & MH_pro_on(-1:Max_pro_2,0:4),MH_tried(-1:Max_pro_2,0:4), | |
23107 | & MH_acc_1(-1:Max_pro_2,0:4),MH_acc_2(-1:Max_pro_2,0:4) | |
23108 | C some constants | |
23109 | DOUBLE PRECISION PI,PI2,PI4,GEV2MB,Q_ch,Q_ch2,Q_ch4 | |
23110 | COMMON /POCONS/ PI,PI2,PI4,GEV2MB, | |
23111 | & Q_ch(-6:6),Q_ch2(-6:6),Q_ch4(-6:6) | |
23112 | ||
23113 | DOUBLE PRECISION PHO_ALPHAS,pho_alphae | |
23114 | DIMENSION PDA(-6:6),PDB(-6:6) | |
23115 | ||
23116 | FDISTR = 0.D0 | |
23117 | C set hard scale QQ for alpha and partondistr. | |
23118 | IF ( NQQAL.EQ.1 ) THEN | |
23119 | QQAL = AQQAL*PT*PT | |
23120 | ELSEIF ( NQQAL.EQ.2 ) THEN | |
23121 | QQAL = AQQAL*X1*X2*ECMP*ECMP*U*V/(1.D0+V*V+U*U) | |
23122 | ELSEIF ( NQQAL.EQ.3 ) THEN | |
23123 | QQAL = AQQAL*X1*X2*ECMP*ECMP | |
23124 | ELSEIF ( NQQAL.EQ.4 ) THEN | |
23125 | QQAL = AQQAL*X1*X2*ECMP*ECMP*(U*V)**(1.D0/3.D0) | |
23126 | ENDIF | |
23127 | IF ( NQQPD.EQ.1 ) THEN | |
23128 | QQPD = AQQPD*PT*PT | |
23129 | ELSEIF ( NQQPD.EQ.2 ) THEN | |
23130 | QQPD = AQQPD*X1*X2*ECMP*ECMP*U*V/(1.D0+V*V+U*U) | |
23131 | ELSEIF ( NQQPD.EQ.3 ) THEN | |
23132 | QQPD = AQQPD*X1*X2*ECMP*ECMP | |
23133 | ELSEIF ( NQQPD.EQ.4 ) THEN | |
23134 | QQPD = AQQPD*X1*X2*ECMP*ECMP*(U*V)**(1.D0/3.D0) | |
23135 | ENDIF | |
23136 | C coupling constants, PDFs | |
23137 | IF(MSPR.LT.9) THEN | |
23138 | ALPHA1 = PHO_ALPHAS(QQAL,3) | |
23139 | ALPHA2 = ALPHA1 | |
23140 | CALL PHO_PDF(1,X1,QQPD,0.D0,PDA) | |
23141 | CALL PHO_PDF(2,X2,QQPD,0.D0,PDB) | |
23142 | IF ( MSPR.EQ.1 .OR. MSPR.EQ.4 ) THEN | |
23143 | PDS = PDA(0)*PDB(0) | |
23144 | ELSE | |
23145 | S2 = 0.D0 | |
23146 | S3 = 0.D0 | |
23147 | S4 = 0.D0 | |
23148 | S5 = 0.D0 | |
23149 | DO 10 I=1,NF | |
23150 | S2 = S2+PDA(I)*PDB(-I)+PDA(-I)*PDB( I) | |
23151 | S3 = S3+PDA(I)*PDB( I)+PDA(-I)*PDB(-I) | |
23152 | S4 = S4+PDA(I)+PDA(-I) | |
23153 | S5 = S5+PDB(I)+PDB(-I) | |
23154 | 10 CONTINUE | |
23155 | IF ((MSPR.EQ.2).OR.(MSPR.EQ.5).OR.(MSPR.EQ.6)) THEN | |
23156 | PDS = S2 | |
23157 | ELSE IF((MSPR.EQ.3).OR.(MSPR.EQ.-1)) THEN | |
23158 | PDS = PDA(0)*S5+PDB(0)*S4 | |
23159 | ELSE IF(MSPR.EQ.7) THEN | |
23160 | PDS = S3 | |
23161 | ELSE IF(MSPR.EQ.8) THEN | |
23162 | PDS = S4*S5-(S2+S3) | |
23163 | ENDIF | |
23164 | ENDIF | |
23165 | ELSE IF(MSPR.LT.12) THEN | |
23166 | ALPHA2 = PHO_ALPHAS(QQAL,2) | |
23167 | IF(IDPDG1.EQ.22) THEN | |
23168 | ALPHA1 = pho_alphae(QQAL) | |
23169 | ELSE IF(IDPDG1.EQ.990) THEN | |
23170 | ALPHA1 = PARMDL(74) | |
23171 | ENDIF | |
23172 | CALL PHO_PDF(2,X2,QQPD,0.D0,PDB) | |
23173 | S4 = 0.D0 | |
23174 | S6 = 0.D0 | |
23175 | DO 15 I=1,NF | |
23176 | S4 = S4+PDB(I)+PDB(-I) | |
23177 | C charge counting | |
23178 | * IF(MOD(I,2).EQ.0) THEN | |
23179 | * S6 = S6+(PDB(I)+PDB(-I))*4.D0/9.D0 | |
23180 | * ELSE | |
23181 | * S6 = S6+(PDB(I)+PDB(-I))*1.D0/9.D0 | |
23182 | * ENDIF | |
23183 | S6 = S6+(PDB(I)+PDB(-I))*Q_ch2(I) | |
23184 | 15 CONTINUE | |
23185 | IF(MSPR.EQ.10) THEN | |
23186 | IF(IDPDG1.EQ.990) THEN | |
23187 | PDS = S4 | |
23188 | ELSE | |
23189 | PDS = S6 | |
23190 | ENDIF | |
23191 | ELSE | |
23192 | PDS = PDB(0) | |
23193 | ENDIF | |
23194 | ELSE IF(MSPR.LT.14) THEN | |
23195 | ALPHA1 = PHO_ALPHAS(QQAL,1) | |
23196 | IF(IDPDG2.EQ.22) THEN | |
23197 | ALPHA2 = pho_alphae(QQAL) | |
23198 | ELSE IF(IDPDG2.EQ.990) THEN | |
23199 | ALPHA2 = PARMDL(74) | |
23200 | ENDIF | |
23201 | CALL PHO_PDF(1,X1,QQPD,0.D0,PDA) | |
23202 | S4 = 0.D0 | |
23203 | S6 = 0.D0 | |
23204 | DO 20 I=1,NF | |
23205 | S4 = S4+PDA(I)+PDA(-I) | |
23206 | C charge counting | |
23207 | * IF(MOD(I,2).EQ.0) THEN | |
23208 | * S6 = S6+(PDA(I)+PDA(-I))*4.D0/9.D0 | |
23209 | * ELSE | |
23210 | * S6 = S6+(PDA(I)+PDA(-I))*1.D0/9.D0 | |
23211 | * ENDIF | |
23212 | S6 = S6+(PDA(I)+PDA(-I))*Q_ch2(I) | |
23213 | 20 CONTINUE | |
23214 | IF(MSPR.EQ.12) THEN | |
23215 | IF(IDPDG2.EQ.990) THEN | |
23216 | PDS = S4 | |
23217 | ELSE | |
23218 | PDS = S6 | |
23219 | ENDIF | |
23220 | ELSE | |
23221 | PDS = PDA(0) | |
23222 | ENDIF | |
23223 | ELSE IF(MSPR.EQ.14) THEN | |
23224 | SSR = X1*X2*ECMP*ECMP | |
23225 | IF(IDPDG1.EQ.22) THEN | |
23226 | ALPHA1 = pho_alphae(SSR) | |
23227 | ELSE IF(IDPDG1.EQ.990) THEN | |
23228 | ALPHA1 = PARMDL(74) | |
23229 | ENDIF | |
23230 | IF(IDPDG2.EQ.22) THEN | |
23231 | ALPHA2 = pho_alphae(SSR) | |
23232 | ELSE IF(IDPDG2.EQ.990) THEN | |
23233 | ALPHA2 = PARMDL(74) | |
23234 | ENDIF | |
23235 | PDS = 1.D0 | |
23236 | ELSE | |
23237 | WRITE(LO,'(/1X,A,I4)') | |
23238 | & 'PHO_HARWGH:ERROR: invalid hard process number (MSPR)',MSPR | |
23239 | CALL PHO_ABORT | |
23240 | ENDIF | |
23241 | ||
23242 | C complete weight | |
23243 | FDISTR = HFac(MSPR)*ALPHA1*ALPHA2*PDS | |
23244 | ||
23245 | C debug output | |
23246 | IF(IDEB(15).GE.20) WRITE(LO,'(1X,A,/5X,I3,2I6,4E10.3)') | |
23247 | & 'PHO_HARWGH: MSPR,ID1,ID2,AL1,AL2,PDS,FDIS', | |
23248 | & MSPR,IDPDG1,IDPDG2,ALPHA1,ALPHA2,PDS,FDISTR | |
23249 | ||
23250 | END | |
23251 | ||
23252 | *$ CREATE PHO_HARSCA.FOR | |
23253 | *COPY PHO_HARSCA | |
23254 | CDECK ID>, PHO_HARSCA | |
23255 | SUBROUTINE PHO_HARSCA(IMODE,IP) | |
23256 | C*********************************************************************** | |
23257 | C | |
23258 | C PHO_HARSCA determines the type of hard subprocess, the partons | |
23259 | C taking part in this subprocess and the kinematic variables | |
23260 | C | |
23261 | C input: IMODE 1 direct processes | |
23262 | C 2 resolved processes | |
23263 | C -1 initialization | |
23264 | C -2 output of statistics | |
23265 | C IP 1-4 particle combination (hadron/photon) | |
23266 | C | |
23267 | C*********************************************************************** | |
23268 | IMPLICIT DOUBLE PRECISION (A-H,O-Z) | |
23269 | SAVE | |
23270 | ||
23271 | PARAMETER( EPS = 1.D-10, | |
23272 | & DEPS = 1.D-30 ) | |
23273 | ||
23274 | C input/output channels | |
23275 | INTEGER LI,LO | |
23276 | COMMON /POINOU/ LI,LO | |
23277 | C event debugging information | |
23278 | INTEGER NMAXD | |
23279 | PARAMETER (NMAXD=100) | |
23280 | INTEGER IDEB,KSPOM,KHPOM,KSREG,KHDIR,KACCEP,KSTRG,KHTRG,KSLOO, | |
23281 | & KHLOO,KSDPO,KHDPO,KEVENT,KSOFT,KHARD | |
23282 | COMMON /PODEBG/ IDEB(NMAXD),KSPOM,KHPOM,KSREG,KHDIR,KACCEP,KSTRG, | |
23283 | & KHTRG,KSLOO,KHLOO,KSDPO,KHDPO,KEVENT,KSOFT,KHARD | |
23284 | C model switches and parameters | |
23285 | CHARACTER*8 MDLNA | |
23286 | INTEGER ISWMDL,IPAMDL | |
23287 | DOUBLE PRECISION PARMDL | |
23288 | COMMON /POMDLS/ MDLNA(50),ISWMDL(50),PARMDL(400),IPAMDL(400) | |
23289 | C internal rejection counters | |
23290 | INTEGER NMXJ | |
23291 | PARAMETER (NMXJ=60) | |
23292 | CHARACTER*10 REJTIT | |
23293 | INTEGER IFAIL | |
23294 | COMMON /POLOOP/ IFAIL(NMXJ),REJTIT(NMXJ) | |
23295 | C hard scattering parameters used for most recent hard interaction | |
23296 | INTEGER NFbeta,NF | |
23297 | DOUBLE PRECISION ALQCD2,BQCD | |
23298 | COMMON /POHAPA/ ALQCD2(3,4),BQCD(4),NFbeta,NF | |
23299 | C data of c.m. system of Pomeron / Reggeon exchange | |
23300 | INTEGER NPOSP,IDPDG1,IDBAM1,IDPDG2,IDBAM2 | |
23301 | DOUBLE PRECISION ECMP,PCMP,PMASSP,PVIRTP,GAMBEP, | |
23302 | & SIDP,CODP,SIFP,COFP | |
23303 | COMMON /POPCMS/ ECMP,PCMP,PMASSP(2),PVIRTP(2),GAMBEP(4), | |
23304 | & SIDP,CODP,SIFP,COFP,NPOSP(2), | |
23305 | & IDPDG1,IDBAM1,IDPDG2,IDBAM2 | |
23306 | C names of hard scattering processes | |
23307 | INTEGER Max_pro_1 | |
23308 | PARAMETER ( Max_pro_1 = 16 ) | |
23309 | CHARACTER*18 PROC | |
23310 | COMMON /POHPRO/ PROC(0:Max_pro_1) | |
23311 | C data on most recent hard scattering | |
23312 | INTEGER IA,IB,IC,ID,IV1,IV2,MSPR,IREJSC | |
23313 | DOUBLE PRECISION PTWANT,AS,AH,ALNS,ALNH,Z1MAX,Z1DIF,Z2MAX,Z2DIF, | |
23314 | & PT,PTfin,ETAC,ETAD,X1,X2,V,U,W,W1,AXX,QQPD,QQAL, | |
23315 | & PDF1,PDF2,WEIGHT,PHI1,PHI2,PHO1,PHO2 | |
23316 | COMMON /POCKIN/ PTWANT,AS,AH,ALNS,ALNH,Z1MAX,Z1DIF,Z2MAX,Z2DIF, | |
23317 | & PT,PTfin,ETAC,ETAD,X1,X2,V,U,W,W1,AXX, | |
23318 | & QQPD,QQAL,PDF1(-6:6),PDF2(-6:6),WEIGHT, | |
23319 | & PHI1(5),PHI2(5),PHO1(5),PHO2(5), | |
23320 | & IA,IB,IC,ID,IV1,IV2,MSPR,IREJSC | |
23321 | C hard scattering data | |
23322 | INTEGER MSCAHD | |
23323 | PARAMETER ( MSCAHD = 50 ) | |
23324 | INTEGER LSCAHD,LSC1HD,LSIDX, | |
23325 | & NINHD,N0INHD,NIVAL,N0IVAL,NOUTHD,NBRAHD,NPROHD | |
23326 | DOUBLE PRECISION PPH,PTHD,ETAHD,Q2SCA,PDFVA,XHD,VHD,X0HD | |
23327 | COMMON /POHSLT/ LSCAHD,LSC1HD,LSIDX(MSCAHD), | |
23328 | & PPH(8*MSCAHD,2),PTHD(MSCAHD),ETAHD(MSCAHD,2), | |
23329 | & Q2SCA(MSCAHD,2),PDFVA(MSCAHD,2), | |
23330 | & XHD(MSCAHD,2),VHD(MSCAHD),X0HD(MSCAHD,2), | |
23331 | & NINHD(MSCAHD,2),N0INHD(MSCAHD,2), | |
23332 | & NIVAL(MSCAHD,2),N0IVAL(MSCAHD,2), | |
23333 | & NOUTHD(MSCAHD,2),NBRAHD(MSCAHD,2),NPROHD(MSCAHD) | |
23334 | C hard cross sections and MC selection weights | |
23335 | INTEGER Max_pro_2 | |
23336 | PARAMETER ( Max_pro_2 = 16 ) | |
23337 | INTEGER IHa_last,IHb_last,MH_pro_on,MH_tried, | |
23338 | & MH_acc_1,MH_acc_2 | |
23339 | DOUBLE PRECISION Hfac,HWgx,HSig,Hdpt,HEcm_last,HQ2a_last,HQ2b_last | |
23340 | COMMON /POHRCS/ Hfac(-1:Max_pro_2),HWgx(-1:Max_pro_2), | |
23341 | & HSig(-1:Max_pro_2),Hdpt(-1:Max_pro_2), | |
23342 | & HEcm_last,HQ2a_last,HQ2b_last,IHa_last,IHb_last, | |
23343 | & MH_pro_on(-1:Max_pro_2,0:4),MH_tried(-1:Max_pro_2,0:4), | |
23344 | & MH_acc_1(-1:Max_pro_2,0:4),MH_acc_2(-1:Max_pro_2,0:4) | |
23345 | C cross sections | |
23346 | INTEGER IPFIL,IFAFIL,IFBFIL | |
23347 | DOUBLE PRECISION SIGTOT,SIGELA,SIGVM,SIGINE,SIGNDF,SIGDIR, | |
23348 | & SIGLSD,SIGHSD,SIGLDD,SIGHDD,SIGCDF, | |
23349 | & SIGPOM,SIGREG,SIGHAR,SIGTR1,SIGTR2,SIGLOO, | |
23350 | & SIGDPO,SIG1SO,SIG1HA,SLOEL,SLOVM,SIGCOR, | |
23351 | & FSUP,FSUD,FSUH,ECMFIL,P2AFIL,P2BFIL | |
23352 | COMMON /POCSEC/ SIGTOT,SIGELA,SIGVM(0:4,0:4),SIGINE,SIGNDF,SIGDIR, | |
23353 | & SIGLSD(2),SIGHSD(2),SIGLDD,SIGHDD,SIGCDF(0:4), | |
23354 | & SIGPOM,SIGREG,SIGHAR,SIGTR1(2),SIGTR2(2),SIGLOO, | |
23355 | & SIGDPO(4),SIG1SO,SIG1HA,SLOEL,SLOVM(4,4),SIGCOR, | |
23356 | & FSUP(2),FSUD(2),FSUH(2),ECMFIL,P2AFIL,P2BFIL, | |
23357 | & IPFIL,IFAFIL,IFBFIL | |
23358 | C some constants | |
23359 | DOUBLE PRECISION PI,PI2,PI4,GEV2MB,Q_ch,Q_ch2,Q_ch4 | |
23360 | COMMON /POCONS/ PI,PI2,PI4,GEV2MB, | |
23361 | & Q_ch(-6:6),Q_ch2(-6:6),Q_ch4(-6:6) | |
23362 | ||
23363 | 111 CONTINUE | |
23364 | ||
23365 | C resolved processes | |
23366 | IF(IMODE.EQ.2) THEN | |
23367 | ||
23368 | MH_pro_on(0,IP) = 0 | |
23369 | HWgx(9) = 0.D0 | |
23370 | DO 15 M=-1,8 | |
23371 | IF(MH_pro_on(M,IP).EQ.1) HWgx(9) = HWgx(9)+HWgx(M) | |
23372 | 15 CONTINUE | |
23373 | IF(HWgx(9).LT.DEPS) THEN | |
23374 | WRITE(LO,'(/1X,2A,I4,1P,E12.4)') 'PHO_HARSCA:ERROR: ', | |
23375 | & 'no resolved process possible for IP',IP,HWgx(9) | |
23376 | CALL PHO_ABORT | |
23377 | ENDIF | |
23378 | C | |
23379 | C ----------------------------------------------I | |
23380 | C begin of iteration loop (resolved processes) I | |
23381 | C I | |
23382 | IREJSC = 0 | |
23383 | 10 CONTINUE | |
23384 | IREJSC = IREJSC+1 | |
23385 | IF(IREJSC.GT.1000) THEN | |
23386 | WRITE(LO,'(/1X,A,I10)') | |
23387 | & 'PHO_HARSCA:ERROR: too many rejections (resolved)',IREJSC | |
23388 | CALL PHO_ABORT | |
23389 | ENDIF | |
23390 | ||
23391 | C find subprocess | |
23392 | B = DT_RNDM(X1)*HWgx(9) | |
23393 | MSPR =-2 | |
23394 | SUM = 0.D0 | |
23395 | 20 MSPR = MSPR+1 | |
23396 | IF ( MH_pro_on(MSPR,IP).EQ.1 ) SUM = SUM+HWgx(MSPR) | |
23397 | IF ( SUM.LT.B .AND. MSPR.LT.8 ) GOTO 20 | |
23398 | ||
23399 | IF(IDEB(78).GE.20) WRITE(LO,'(1x,a,i3,i6)') | |
23400 | & 'PHO_HARSCA: resolved process (MSPR,IREJSC)',MSPR,IREJSC | |
23401 | ||
23402 | C find kin. variables X1,X2 and V | |
23403 | CALL PHO_HARKIN(IREJ) | |
23404 | IF(IREJ.NE.0) THEN | |
23405 | IFAIL(29) = IFAIL(29)+1 | |
23406 | GOTO 10 | |
23407 | ENDIF | |
23408 | C calculate remaining distribution | |
23409 | CALL PHO_HARWGH(PDS,PDF1,PDF2,F) | |
23410 | C actualize counter for cross-section calculation | |
23411 | if(F.LE.1.D-15) then | |
23412 | F = 0.D0 | |
23413 | goto 10 | |
23414 | endif | |
23415 | * XSECT(5,MSPR) = XSECT(5,MSPR)+F | |
23416 | * XSECT(6,MSPR) = XSECT(6,MSPR)+F*F | |
23417 | MH_tried(MSPR,IP) = MH_tried(MSPR,IP)+1 | |
23418 | C check F against FMAX | |
23419 | WEIGHT = F/(HWgx(MSPR)+DEPS) | |
23420 | IF ( WEIGHT.LT.DT_RNDM(X2) ) GOTO 10 | |
23421 | C------------------------------------------------------------------- | |
23422 | IF(WEIGHT.GT.1.D0) THEN | |
23423 | WRITE(LO,1234) MSPR,IP,IDPDG1,IDPDG2,F,HWgx(MSPR),WEIGHT | |
23424 | 1234 FORMAT(/,' PHO_HARSCA: (resolved) W>1 (MSPR,IP,ID1,2)', | |
23425 | & 2I3,2I7,/' F,HWgx(MSPR),W',3E12.4) | |
23426 | WRITE(LO,'(1X,A,5E11.3)') 'ECM,PTWANT,AS,AH,PT', | |
23427 | & ECMP,PTWANT,AS,AH,PT | |
23428 | WRITE(LO,'(1X,A,5E11.3)') 'ETAC,ETAD,X1,X2,V', | |
23429 | & ETAC,ETAD,X1,X2,V | |
23430 | CALL PHO_PREVNT(-1) | |
23431 | ENDIF | |
23432 | C------------------------------------------------------------------- | |
23433 | C I | |
23434 | C end of iteration loop (resolved processes) I | |
23435 | C --------------------------------------------I | |
23436 | C | |
23437 | C********************************************************************* | |
23438 | C | |
23439 | C direct processes | |
23440 | ||
23441 | ELSE IF(IMODE.EQ.1) THEN | |
23442 | ||
23443 | C single-resolved processes kinematically forbidden | |
23444 | if(Z1DIF.lt.0.D0) then | |
23445 | HWgx(10) = 0.D0 | |
23446 | HWgx(11) = 0.D0 | |
23447 | HWgx(12) = 0.D0 | |
23448 | HWgx(13) = 0.D0 | |
23449 | endif | |
23450 | ||
23451 | HWgx(15) = 0.D0 | |
23452 | if((IPAMDL(115).eq.0).and.(IP.eq.1)) then | |
23453 | DO M= 10,14 | |
23454 | IF(MH_pro_on(M,IP).EQ.1) then | |
23455 | if((M.eq.10).or.(M.eq.11)) then | |
23456 | fac = FSUH(1)*FSUP(2) | |
23457 | else if((M.eq.12).or.(M.eq.13)) then | |
23458 | fac = FSUP(1)*FSUH(2) | |
23459 | else | |
23460 | fac = FSUH(1)*FSUH(2) | |
23461 | endif | |
23462 | HWgx(15) = HWgx(15)+HWgx(M)*fac | |
23463 | endif | |
23464 | ENDDO | |
23465 | else | |
23466 | DO M= 10,14 | |
23467 | IF(MH_pro_on(M,IP).EQ.1) HWgx(15)=HWgx(15)+HWgx(M) | |
23468 | ENDDO | |
23469 | endif | |
23470 | IF(HWgx(15).LT.DEPS) THEN | |
23471 | WRITE(LO,'(/1X,2A,I4)') 'PHO_HARSCA:ERROR: ', | |
23472 | & 'no direct/single-resolved process possible (IP)',IP | |
23473 | CALL PHO_ABORT | |
23474 | ENDIF | |
23475 | C | |
23476 | C ----------------------------------------------I | |
23477 | C begin of iteration loop (direct processes) I | |
23478 | C I | |
23479 | IREJSC = 0 | |
23480 | 100 CONTINUE | |
23481 | IREJSC = IREJSC+1 | |
23482 | IF(IREJSC.GT.1000) THEN | |
23483 | WRITE(LO,'(/1X,A,I10)') | |
23484 | & 'PHO_HARSCA:ERROR: too many rejections (direct)',IREJSC | |
23485 | CALL PHO_ABORT | |
23486 | ENDIF | |
23487 | ||
23488 | C find subprocess | |
23489 | B = DT_RNDM(X1)*HWgx(15) | |
23490 | MSPR = 9 | |
23491 | SUM = 0.D0 | |
23492 | if((IPAMDL(115).eq.0).and.(IP.eq.1)) then | |
23493 | 150 continue | |
23494 | MSPR = MSPR+1 | |
23495 | IF(MH_pro_on(MSPR,IP).EQ.1) then | |
23496 | if((MSPR.eq.10).or.(MSPR.eq.11)) then | |
23497 | fac = FSUH(1)*FSUP(2) | |
23498 | else if((MSPR.eq.12).or.(MSPR.eq.13)) then | |
23499 | fac = FSUP(1)*FSUH(2) | |
23500 | else | |
23501 | fac = FSUH(1)*FSUH(2) | |
23502 | endif | |
23503 | SUM = SUM+HWgx(MSPR)*fac | |
23504 | endif | |
23505 | IF ( SUM.LT.B .AND. MSPR.LT.14 ) GOTO 150 | |
23506 | else | |
23507 | 200 continue | |
23508 | MSPR = MSPR+1 | |
23509 | IF(MH_pro_on(MSPR,IP).EQ.1) SUM = SUM+HWgx(MSPR) | |
23510 | IF ( SUM.LT.B .AND. MSPR.LT.14 ) GOTO 200 | |
23511 | endif | |
23512 | ||
23513 | IF(IDEB(78).GE.20) WRITE(LO,'(1x,a,i3,i6)') | |
23514 | & 'PHO_HARSCA: direct process (MSPR,IREJSC)',MSPR,IREJSC | |
23515 | ||
23516 | C find kin. variables X1,X2 and V | |
23517 | CALL PHO_HARKIN(IREJ) | |
23518 | IF(IREJ.NE.0) THEN | |
23519 | IFAIL(28) = IFAIL(28)+1 | |
23520 | GOTO 100 | |
23521 | ENDIF | |
23522 | ||
23523 | C calculate remaining distribution | |
23524 | CALL PHO_HARWGH(PDS,PDF1,PDF2,F) | |
23525 | ||
23526 | C counter for cross-section calculation | |
23527 | if(F.LE.1.D-15) then | |
23528 | F=0.D0 | |
23529 | goto 100 | |
23530 | endif | |
23531 | * XSECT(5,MSPR) = XSECT(5,MSPR)+F | |
23532 | * XSECT(6,MSPR) = XSECT(6,MSPR)+F*F | |
23533 | MH_tried(MSPR,IP) = MH_tried(MSPR,IP)+1 | |
23534 | C check F against FMAX | |
23535 | WEIGHT = F/(HWgx(MSPR)+DEPS) | |
23536 | IF(WEIGHT.LT.DT_RNDM(X2)) GOTO 100 | |
23537 | C------------------------------------------------------------------- | |
23538 | IF(WEIGHT.GT.1.D0) THEN | |
23539 | WRITE(LO,1235) MSPR,IP,IDPDG1,IDPDG2,F,HWgx(MSPR),WEIGHT | |
23540 | 1235 FORMAT(/,' PHO_HARSCA: (direct) W>1 (MSPR,IP,ID1,2)', | |
23541 | & 2I3,2I7,/,' F,HWgx(MSPR),W',3E12.4) | |
23542 | WRITE(LO,'(1X,A,5E11.3)') 'ECM,PTWANT,AS,AH,PT', | |
23543 | & ECMP,PTWANT,AS,AH,PT | |
23544 | WRITE(LO,'(1X,A,5E11.3)') 'ETAC,ETAD,X1,X2,V', | |
23545 | & ETAC,ETAD,X1,X2,V | |
23546 | CALL PHO_PREVNT(-1) | |
23547 | ENDIF | |
23548 | C------------------------------------------------------------------- | |
23549 | C I | |
23550 | C end of iteration loop (direct processes) I | |
23551 | C --------------------------------------------I | |
23552 | ||
23553 | ELSE IF(IMODE.EQ.-1) THEN | |
23554 | ||
23555 | C initialize cross section calculations | |
23556 | ||
23557 | DO 40 M=-1,Max_pro_2 | |
23558 | * DO 30 I=5,6 | |
23559 | * XSECT(I,M) = 0.D0 | |
23560 | *30 CONTINUE | |
23561 | C reset counters | |
23562 | DO 35 J=1,4 | |
23563 | MH_tried(M,J) = 0 | |
23564 | MH_acc_1(M,J) = 0 | |
23565 | MH_acc_2(M,J) = 0 | |
23566 | 35 CONTINUE | |
23567 | 40 CONTINUE | |
23568 | IF(IDEB(78).GE.0) THEN | |
23569 | WRITE(LO,'(/1X,A,/1X,A)') | |
23570 | & 'PHO_HARSCA: activated hard processes', | |
23571 | & '------------------------------------' | |
23572 | WRITE(LO,'(5X,A)') 'PROCESS, IP= 1 ... 4 (on/off)' | |
23573 | DO 42 M=1,Max_pro_2 | |
23574 | WRITE(LO,'(1X,I3,5X,A,4I3)') M,PROC(M), | |
23575 | & (MH_pro_on(M,J),J=1,4) | |
23576 | 42 CONTINUE | |
23577 | ENDIF | |
23578 | RETURN | |
23579 | ||
23580 | ELSE IF(IMODE.EQ.-2) THEN | |
23581 | ||
23582 | C calculation of process statistics | |
23583 | ||
23584 | do K=1,4 | |
23585 | ||
23586 | MH_tried(0,K) = 0 | |
23587 | MH_acc_1(0,K) = 0 | |
23588 | MH_acc_2(0,K) = 0 | |
23589 | MH_tried(9,K) = 0 | |
23590 | MH_acc_1(9,K) = 0 | |
23591 | MH_acc_2(9,K) = 0 | |
23592 | MH_tried(15,K) = 0 | |
23593 | MH_acc_1(15,K) = 0 | |
23594 | MH_acc_2(15,K) = 0 | |
23595 | ||
23596 | MH_tried(3,K) = MH_tried(3,K)+MH_tried(-1,K) | |
23597 | MH_acc_1(3,K) = MH_acc_1(3,K)+MH_acc_1(-1,K) | |
23598 | MH_acc_2(3,K) = MH_acc_2(3,K)+MH_acc_2(-1,K) | |
23599 | ||
23600 | do M=1,8 | |
23601 | MH_tried(9,K) = MH_tried(9,K)+MH_tried(M,K) | |
23602 | MH_acc_1(9,K) = MH_acc_1(9,K)+MH_acc_1(M,K) | |
23603 | MH_acc_2(9,K) = MH_acc_2(9,K)+MH_acc_2(M,K) | |
23604 | enddo | |
23605 | do M=10,14 | |
23606 | MH_tried(15,K) = MH_tried(15,K)+MH_tried(M,K) | |
23607 | MH_acc_1(15,K) = MH_acc_1(15,K)+MH_acc_1(M,K) | |
23608 | MH_acc_2(15,K) = MH_acc_2(15,K)+MH_acc_2(M,K) | |
23609 | enddo | |
23610 | MH_tried(0,K) = MH_tried(9,K)+MH_tried(15,K) | |
23611 | MH_acc_1(0,K) = MH_acc_1(9,K)+MH_acc_1(15,K) | |
23612 | MH_acc_2(0,K) = MH_acc_2(9,K)+MH_acc_2(15,K) | |
23613 | enddo | |
23614 | ||
23615 | IF(IDEB(78).GE.1) THEN | |
23616 | WRITE(LO,'(/1X,A,/1X,A)') | |
23617 | & 'PHO_HARSCA: internal rejection statistics', | |
23618 | & '-----------------------------------------' | |
23619 | do K=1,4 | |
23620 | IF(MH_tried(0,K).GT.0) THEN | |
23621 | WRITE(LO,'(5X,A,I3)') | |
23622 | & 'process (sampled/accepted) for IP:',K | |
23623 | do M=0,Max_pro_2 | |
23624 | WRITE(LO,'(1X,I3,1X,A,2X,3I12,F10.4)') M,PROC(M), | |
23625 | & MH_tried(M,K),MH_acc_1(M,K),MH_acc_2(K,K), | |
23626 | & dble(MH_acc_1(M,K))/dble(max(1,MH_tried(M,K))) | |
23627 | enddo | |
23628 | ENDIF | |
23629 | enddo | |
23630 | ENDIF | |
23631 | RETURN | |
23632 | ||
23633 | ELSE | |
23634 | WRITE(LO,'(/1X,2A,I10)') 'PHO_HARSCA:ERROR: ', | |
23635 | & 'unsupported mode',IMODE | |
23636 | CALL PHO_ABORT | |
23637 | ENDIF | |
23638 | ||
23639 | C the event is accepted now | |
23640 | C actualize counter for accepted events | |
23641 | MH_acc_1(MSPR,IP) = MH_acc_1(MSPR,IP)+1 | |
23642 | IF(MSPR.EQ.-1) MSPR = 3 | |
23643 | C | |
23644 | C find flavor of initial partons | |
23645 | C | |
23646 | SUM = 0.D0 | |
23647 | SCHECK = DT_RNDM(SUM)*PDS-EPS | |
23648 | IF ( MSPR.EQ.1 .OR. MSPR.EQ.4 ) THEN | |
23649 | IA = 0 | |
23650 | IB = 0 | |
23651 | ELSEIF ( MSPR.EQ.2 .OR. MSPR.EQ.5 .OR. MSPR.EQ.6 ) THEN | |
23652 | DO 610 IA=-NF,NF | |
23653 | IF ( IA.EQ.0 ) GOTO 610 | |
23654 | SUM = SUM+PDF1(IA)*PDF2(-IA) | |
23655 | IF ( SUM.GE.SCHECK ) GOTO 620 | |
23656 | 610 CONTINUE | |
23657 | 620 IB =-IA | |
23658 | ELSEIF ( MSPR.EQ.3 ) THEN | |
23659 | IB = 0 | |
23660 | DO 630 IA=-NF,NF | |
23661 | IF ( IA.EQ.0 ) GOTO 630 | |
23662 | SUM = SUM+PDF1(0)*PDF2(IA) | |
23663 | IF ( SUM.GE.SCHECK ) GOTO 640 | |
23664 | SUM = SUM+PDF1(IA)*PDF2(0) | |
23665 | IF ( SUM.GE.SCHECK ) GOTO 650 | |
23666 | 630 CONTINUE | |
23667 | 640 IB = IA | |
23668 | IA = 0 | |
23669 | 650 CONTINUE | |
23670 | ELSEIF ( MSPR.EQ.7 ) THEN | |
23671 | DO 660 IA=-NF,NF | |
23672 | IF ( IA.EQ.0 ) GOTO 660 | |
23673 | SUM = SUM+PDF1(IA)*PDF2(IA) | |
23674 | IF ( SUM.GE.SCHECK ) GOTO 670 | |
23675 | 660 CONTINUE | |
23676 | 670 IB = IA | |
23677 | ELSEIF ( MSPR.EQ.8 ) THEN | |
23678 | DO 690 IA=-NF,NF | |
23679 | IF ( IA.EQ.0 ) GOTO 690 | |
23680 | DO 680 IB=-NF,NF | |
23681 | IF ( ABS(IB).EQ.ABS(IA) .OR. IB.EQ.0 ) GOTO 680 | |
23682 | SUM = SUM+PDF1(IA)*PDF2(IB) | |
23683 | IF ( SUM.GE.SCHECK ) GOTO 700 | |
23684 | 680 CONTINUE | |
23685 | 690 CONTINUE | |
23686 | 700 CONTINUE | |
23687 | ELSEIF ( MSPR.EQ.10 ) THEN | |
23688 | IA = 0 | |
23689 | DO 710 IB=-NF,NF | |
23690 | IF ( IB.NE.0 ) THEN | |
23691 | IF(IDPDG1.EQ.22) THEN | |
23692 | * IF(MOD(ABS(IB),2).EQ.0) THEN | |
23693 | * SUM = SUM+PDF2(IB)*4.D0/9.D0 | |
23694 | * ELSE | |
23695 | * SUM = SUM+PDF2(IB)*1.D0/9.D0 | |
23696 | * ENDIF | |
23697 | SUM = SUM+PDF2(IB)*Q_ch2(IB) | |
23698 | ELSE | |
23699 | SUM = SUM+PDF2(IB) | |
23700 | ENDIF | |
23701 | IF ( SUM.GE.SCHECK ) GOTO 720 | |
23702 | ENDIF | |
23703 | 710 CONTINUE | |
23704 | 720 CONTINUE | |
23705 | ELSEIF ( MSPR.EQ.12 ) THEN | |
23706 | IB = 0 | |
23707 | DO 810 IA=-NF,NF | |
23708 | IF ( IA.NE.0 ) THEN | |
23709 | IF(IDPDG2.EQ.22) THEN | |
23710 | * IF(MOD(ABS(IA),2).EQ.0) THEN | |
23711 | * SUM = SUM+PDF1(IA)*4.D0/9.D0 | |
23712 | * ELSE | |
23713 | * SUM = SUM+PDF1(IA)*1.D0/9.D0 | |
23714 | * ENDIF | |
23715 | SUM = SUM+PDF1(IA)*Q_ch2(IA) | |
23716 | ELSE | |
23717 | SUM = SUM+PDF1(IA) | |
23718 | ENDIF | |
23719 | IF ( SUM.GE.SCHECK ) GOTO 820 | |
23720 | ENDIF | |
23721 | 810 CONTINUE | |
23722 | 820 CONTINUE | |
23723 | ELSEIF ((MSPR.EQ.11).OR.(MSPR.EQ.13).OR.(MSPR.EQ.14)) THEN | |
23724 | IA = 0 | |
23725 | IB = 0 | |
23726 | ENDIF | |
23727 | C final check | |
23728 | IF((ABS(IA).GT.NF).OR.(ABS(IB).GT.NF)) THEN | |
ecf67adb | 23729 | WRITE(LO,*) 'PHO_HARSCA: rejection, final check IA,IB',IA,IB |
23730 | WRITE(LO,*) 'EVENT,MSPR,IA,IB,NF: ',KEVENT,MSPR,IA,IB,NF | |
9aaba0d6 | 23731 | GOTO 111 |
23732 | ENDIF | |
23733 | C | |
23734 | C find flavour of final partons | |
23735 | C | |
23736 | IC = IA | |
23737 | ID = IB | |
23738 | IF ( MSPR.EQ.2 ) THEN | |
23739 | IC = 0 | |
23740 | ID = 0 | |
23741 | ELSEIF ( MSPR.EQ.4 ) THEN | |
23742 | IC = INT(FLOAT(NF+NF)*DT_RNDM(SUM))+1 | |
23743 | IF ( IC.GT.NF ) IC = NF-IC | |
23744 | ID =-IC | |
23745 | ELSEIF ( MSPR.EQ.6 ) THEN | |
23746 | IC = INT(FLOAT(NF+NF-2)*DT_RNDM(SUM))+1 | |
23747 | IF ( IC.GT.NF-1 ) IC = NF-1-IC | |
23748 | IF ( ABS(IC).EQ.ABS(IA) ) IC = SIGN(NF,IC) | |
23749 | ID =-IC | |
23750 | ELSEIF ( MSPR.EQ.11) THEN | |
23751 | SUM = 0.D0 | |
23752 | DO 730 IC=-NF,NF | |
23753 | IF ( IC.NE.0 ) THEN | |
23754 | IF(IDPDG1.EQ.22) THEN | |
23755 | * IF(MOD(ABS(IC),2).EQ.0) THEN | |
23756 | * SUM = SUM + 4.D0 | |
23757 | * ELSE | |
23758 | * SUM = SUM + 1.D0 | |
23759 | * ENDIF | |
23760 | SUM = SUM + Q_ch2(IC) | |
23761 | ELSE | |
23762 | SUM = SUM + 1.D0 | |
23763 | ENDIF | |
23764 | ENDIF | |
23765 | 730 CONTINUE | |
23766 | SCHECK = DT_RNDM(SUM)*SUM-EPS | |
23767 | SUM = 0.D0 | |
23768 | DO 740 IC=-NF,NF | |
23769 | IF ( IC.NE.0 ) THEN | |
23770 | IF(IDPDG1.EQ.22) THEN | |
23771 | * IF(MOD(ABS(IC),2).EQ.0) THEN | |
23772 | * SUM = SUM + 4.D0 | |
23773 | * ELSE | |
23774 | * SUM = SUM + 1.D0 | |
23775 | * ENDIF | |
23776 | SUM = SUM + Q_ch2(IC) | |
23777 | ELSE | |
23778 | SUM = SUM + 1.D0 | |
23779 | ENDIF | |
23780 | IF ( SUM.GE.SCHECK ) GOTO 750 | |
23781 | ENDIF | |
23782 | 740 CONTINUE | |
23783 | 750 CONTINUE | |
23784 | ID = -IC | |
23785 | ELSEIF ( MSPR.EQ.12) THEN | |
23786 | IC = 0 | |
23787 | ID = IA | |
23788 | ELSEIF ( MSPR.EQ.13) THEN | |
23789 | SUM = 0.D0 | |
23790 | DO 830 IC=-NF,NF | |
23791 | IF ( IC.NE.0 ) THEN | |
23792 | IF(IDPDG2.EQ.22) THEN | |
23793 | * IF(MOD(ABS(IC),2).EQ.0) THEN | |
23794 | * SUM = SUM + 4.D0 | |
23795 | * ELSE | |
23796 | * SUM = SUM + 1.D0 | |
23797 | * ENDIF | |
23798 | SUM = SUM + Q_ch2(IC) | |
23799 | ELSE | |
23800 | SUM = SUM + 1.D0 | |
23801 | ENDIF | |
23802 | ENDIF | |
23803 | 830 CONTINUE | |
23804 | SCHECK = DT_RNDM(SUM)*SUM-EPS | |
23805 | SUM = 0.D0 | |
23806 | DO 840 IC=-NF,NF | |
23807 | IF ( IC.NE.0 ) THEN | |
23808 | IF(IDPDG2.EQ.22) THEN | |
23809 | * IF(MOD(ABS(IC),2).EQ.0) THEN | |
23810 | * SUM = SUM + 4.D0 | |
23811 | * ELSE | |
23812 | * SUM = SUM + 1.D0 | |
23813 | * ENDIF | |
23814 | SUM = SUM + Q_ch2(IC) | |
23815 | ELSE | |
23816 | SUM = SUM + 1.D0 | |
23817 | ENDIF | |
23818 | IF ( SUM.GE.SCHECK ) GOTO 850 | |
23819 | ENDIF | |
23820 | 840 CONTINUE | |
23821 | 850 CONTINUE | |
23822 | ID = -IC | |
23823 | ELSEIF ( MSPR.EQ.14) THEN | |
23824 | SUM = 0.D0 | |
23825 | DO 930 IC=1,NF | |
23826 | FAC1 = 1.D0 | |
23827 | FAC2 = 1.D0 | |
23828 | IF(MOD(ABS(IC),2).EQ.0) THEN | |
23829 | IF(IDPDG1.EQ.22) FAC1 = 4.D0 | |
23830 | IF(IDPDG2.EQ.22) FAC2 = 4.D0 | |
23831 | ENDIF | |
23832 | SUM = SUM + FAC1*FAC2 | |
23833 | 930 CONTINUE | |
23834 | IF(IPAMDL(64).NE.0) THEN | |
23835 | IF((IDPDG1.EQ.22).AND.(IDPDG2.EQ.22)) SUM = SUM + 81.D0 | |
23836 | ENDIF | |
23837 | SCHECK = DT_RNDM(SUM)*SUM-EPS | |
23838 | SUM = 0.D0 | |
23839 | DO 940 IC=1,NF | |
23840 | FAC1 = 1.D0 | |
23841 | FAC2 = 1.D0 | |
23842 | IF(MOD(ABS(IC),2).EQ.0) THEN | |
23843 | IF(IDPDG1.EQ.22) FAC1 = 4.D0 | |
23844 | IF(IDPDG2.EQ.22) FAC2 = 4.D0 | |
23845 | ENDIF | |
23846 | SUM = SUM + FAC1*FAC2 | |
23847 | IF ( SUM.GE.SCHECK ) GOTO 950 | |
23848 | 940 CONTINUE | |
23849 | IC = 15 | |
23850 | 950 CONTINUE | |
23851 | ID = -IC | |
23852 | IF(DT_RNDM(FAC1).GT.0.5D0) CALL PHO_SWAPI(IC,ID) | |
23853 | ENDIF | |
23854 | if(IC.eq.0) then | |
23855 | XM3 = 0.D0 | |
23856 | else | |
23857 | XM3 = PHO_PMASS(IC,3) | |
23858 | endif | |
23859 | if(ID.eq.0) then | |
23860 | XM4 = 0.D0 | |
23861 | else | |
23862 | XM4 = PHO_PMASS(ID,3) | |
23863 | endif | |
23864 | IF(ABS(IC).EQ.15) GOTO 955 | |
23865 | ||
23866 | C valence quarks involved? | |
23867 | IV1 = 0 | |
23868 | IF(IA.NE.0) THEN | |
23869 | IF(IDPDG1.EQ.22) THEN | |
23870 | CALL PHO_QPMPDF(IA,X1,QQPD,0.D0,PVIRTP(1),FXP) | |
23871 | IF(DT_RNDM(XM3)*PDF1(IA).GT.PDF1(IA)-FXP) IV1 = 1 | |
23872 | ELSE | |
23873 | IF(DT_RNDM(XM3)*PDF1(IA).GT.PDF1(-IA)) IV1 = 1 | |
23874 | ENDIF | |
23875 | ENDIF | |
23876 | IV2 = 0 | |
23877 | IF(IB.NE.0) THEN | |
23878 | IF(IDPDG2.EQ.22) THEN | |
23879 | CALL PHO_QPMPDF(IB,X2,QQPD,0.D0,PVIRTP(2),FXP) | |
23880 | IF(DT_RNDM(XM4)*PDF2(IB).GT.PDF2(IB)-FXP) IV2 = 1 | |
23881 | ELSE | |
23882 | IF(DT_RNDM(XM4)*PDF2(IB).GT.PDF2(-IB)) IV2 = 1 | |
23883 | ENDIF | |
23884 | ENDIF | |
23885 | C | |
23886 | C fill event record | |
23887 | C | |
23888 | 955 CONTINUE | |
23889 | CALL PHO_SFECFE(SINPHI,COSPHI) | |
23890 | ECM2 = ECMP/2.D0 | |
23891 | C incoming partons | |
23892 | PHI1(1) = 0.D0 | |
23893 | PHI1(2) = 0.D0 | |
23894 | PHI1(3) = ECM2*X1 | |
23895 | PHI1(4) = PHI1(3) | |
23896 | PHI1(5) = 0.D0 | |
23897 | PHI2(1) = 0.D0 | |
23898 | PHI2(2) = 0.D0 | |
23899 | PHI2(3) = -ECM2*X2 | |
23900 | PHI2(4) = -PHI2(3) | |
23901 | PHI2(5) = 0.D0 | |
23902 | C outgoing partons | |
23903 | PHO1(1) = PT*COSPHI | |
23904 | PHO1(2) = PT*SINPHI | |
23905 | PHO1(3) = -ECM2*(U*X1-V*X2) | |
23906 | PHO1(4) = -ECM2*(U*X1+V*X2) | |
23907 | PHO1(5) = XM3 | |
23908 | PHO2(1) = -PHO1(1) | |
23909 | PHO2(2) = -PHO1(2) | |
23910 | PHO2(3) = -ECM2*(V*X1-U*X2) | |
23911 | PHO2(4) = -ECM2*(V*X1+U*X2) | |
23912 | PHO2(5) = XM4 | |
23913 | ||
23914 | C convert to mass shell | |
23915 | CALL PHO_MSHELL(PHO1,PHO2,XM3,XM4,PHO1,PHO2,IREJ) | |
23916 | IF(IREJ.NE.0) THEN | |
23917 | IF(IDEB(78).GE.5) WRITE(LO,'(1X,A,1P,3E11.3)') | |
23918 | & 'PHO_HARSCA: rejection by PHO_MSHELL (PT,M1,M2)', | |
23919 | & PT,XM3,XM4 | |
23920 | GOTO 111 | |
23921 | ENDIF | |
23922 | PTfin = SQRT(PHO1(1)**2+PHO1(2)**2) | |
23923 | ||
23924 | C debug output | |
23925 | IF(IDEB(78).GE.20) THEN | |
23926 | SHAT = X1*X2*ECMP*ECMP | |
23927 | WRITE(LO,'(1X,A,5I4)') 'PHO_HARSCA: MSPR,IA,IB,IC,ID', | |
23928 | & MSPR,IA,IB,IC,ID | |
23929 | WRITE(LO,'(5X,A,1P,4E11.3)') 'X1/2,MU2,Q2 ',X1,X2,QQPD,QQAL | |
23930 | WRITE(LO,'(5X,A,1P,4E11.3)') 'U,V,PT,SHAT ',U,V,PT,SHAT | |
23931 | WRITE(LO,'(5X,A,1P,5E11.3)') 'PHI1 ',PHI1 | |
23932 | WRITE(LO,'(5X,A,1P,5E11.3)') 'PHI2 ',PHI2 | |
23933 | WRITE(LO,'(5X,A,1P,5E11.3)') 'PHO1 ',PHO1 | |
23934 | WRITE(LO,'(5X,A,1P,5E11.3)') 'PHO2 ',PHO2 | |
23935 | ENDIF | |
23936 | ||
23937 | END | |
23938 | ||
23939 | *$ CREATE PHO_HARFAC.FOR | |
23940 | *COPY PHO_HARFAC | |
23941 | CDECK ID>, PHO_HARFAC | |
23942 | SUBROUTINE PHO_HARFAC(PTCUT,ECMI) | |
23943 | C********************************************************************* | |
23944 | C | |
23945 | C initialization: find scaling factors and maxima of remaining | |
23946 | C weights | |
23947 | C | |
23948 | C input: PTCUT transverse momentum cutoff | |
23949 | C ECMI cms energy | |
23950 | C | |
23951 | C output: Hfac(-1:Max_pro_2) field for sampling hard processes | |
23952 | C | |
23953 | C********************************************************************* | |
23954 | IMPLICIT DOUBLE PRECISION (A-H,O-Z) | |
23955 | SAVE | |
23956 | ||
23957 | PARAMETER ( MXABWT = 96 ) | |
23958 | ||
23959 | C input/output channels | |
23960 | INTEGER LI,LO | |
23961 | COMMON /POINOU/ LI,LO | |
23962 | C data of c.m. system of Pomeron / Reggeon exchange | |
23963 | INTEGER NPOSP,IDPDG1,IDBAM1,IDPDG2,IDBAM2 | |
23964 | DOUBLE PRECISION ECMP,PCMP,PMASSP,PVIRTP,GAMBEP, | |
23965 | & SIDP,CODP,SIFP,COFP | |
23966 | COMMON /POPCMS/ ECMP,PCMP,PMASSP(2),PVIRTP(2),GAMBEP(4), | |
23967 | & SIDP,CODP,SIFP,COFP,NPOSP(2), | |
23968 | & IDPDG1,IDBAM1,IDPDG2,IDBAM2 | |
23969 | C some constants | |
23970 | DOUBLE PRECISION PI,PI2,PI4,GEV2MB,Q_ch,Q_ch2,Q_ch4 | |
23971 | COMMON /POCONS/ PI,PI2,PI4,GEV2MB, | |
23972 | & Q_ch(-6:6),Q_ch2(-6:6),Q_ch4(-6:6) | |
23973 | C hard scattering parameters used for most recent hard interaction | |
23974 | INTEGER NFbeta,NF | |
23975 | DOUBLE PRECISION ALQCD2,BQCD | |
23976 | COMMON /POHAPA/ ALQCD2(3,4),BQCD(4),NFbeta,NF | |
23977 | C integration precision for hard cross sections (obsolete) | |
23978 | INTEGER NGAUP1,NGAUP2,NGAUET,NGAUIN,NGAUSO | |
23979 | COMMON /POGAUP/ NGAUP1,NGAUP2,NGAUET,NGAUIN,NGAUSO | |
23980 | C data on most recent hard scattering | |
23981 | INTEGER IA,IB,IC,ID,IV1,IV2,MSPR,IREJSC | |
23982 | DOUBLE PRECISION PTWANT,AS,AH,ALNS,ALNH,Z1MAX,Z1DIF,Z2MAX,Z2DIF, | |
23983 | & PT,PTfin,ETAC,ETAD,X1,X2,V,U,W,W1,AXX,QQPD,QQAL, | |
23984 | & PDF1,PDF2,WEIGHT,PHI1,PHI2,PHO1,PHO2 | |
23985 | COMMON /POCKIN/ PTWANT,AS,AH,ALNS,ALNH,Z1MAX,Z1DIF,Z2MAX,Z2DIF, | |
23986 | & PT,PTfin,ETAC,ETAD,X1,X2,V,U,W,W1,AXX, | |
23987 | & QQPD,QQAL,PDF1(-6:6),PDF2(-6:6),WEIGHT, | |
23988 | & PHI1(5),PHI2(5),PHO1(5),PHO2(5), | |
23989 | & IA,IB,IC,ID,IV1,IV2,MSPR,IREJSC | |
23990 | C hard cross sections and MC selection weights | |
23991 | INTEGER Max_pro_2 | |
23992 | PARAMETER ( Max_pro_2 = 16 ) | |
23993 | INTEGER IHa_last,IHb_last,MH_pro_on,MH_tried, | |
23994 | & MH_acc_1,MH_acc_2 | |
23995 | DOUBLE PRECISION Hfac,HWgx,HSig,Hdpt,HEcm_last,HQ2a_last,HQ2b_last | |
23996 | COMMON /POHRCS/ Hfac(-1:Max_pro_2),HWgx(-1:Max_pro_2), | |
23997 | & HSig(-1:Max_pro_2),Hdpt(-1:Max_pro_2), | |
23998 | & HEcm_last,HQ2a_last,HQ2b_last,IHa_last,IHb_last, | |
23999 | & MH_pro_on(-1:Max_pro_2,0:4),MH_tried(-1:Max_pro_2,0:4), | |
24000 | & MH_acc_1(-1:Max_pro_2,0:4),MH_acc_2(-1:Max_pro_2,0:4) | |
24001 | ||
24002 | DIMENSION ABSZ(MXABWT),WEIG(MXABWT) | |
24003 | DIMENSION S(-1:Max_pro_2),S1(-1:Max_pro_2),S2(-1:Max_pro_2), | |
24004 | & F124(-1:Max_pro_2) | |
24005 | DATA F124 / 1.D0,0.D0, | |
24006 | & 4.D0,2.D0,2.D0,2.D0,4.D0,1.D0,4.D0,4.D0,0.D0,1.D0, | |
24007 | & 2.D0,1.D0,2.D0,1.D0,0.D0,1.D0 / | |
24008 | ||
24009 | SS = ECMI*ECMI | |
24010 | AH = (2.D0*PTCUT/ECMI)**2 | |
24011 | ALN = LOG(AH) | |
24012 | HLN = LOG(0.5D0) | |
24013 | NPOINT = NGAUIN | |
24014 | CALL PHO_GAUSET(0.D0,1.D0,NPOINT,ABSZ,WEIG) | |
24015 | DO 10 M=-1,Max_pro_2 | |
24016 | S1(M) = 0.D0 | |
24017 | 10 CONTINUE | |
24018 | ||
24019 | C resolved processes | |
24020 | DO 80 I1=1,NPOINT | |
24021 | Z1 = ABSZ(I1) | |
24022 | X1 = EXP(ALN*Z1) | |
24023 | DO 20 M=-1,9 | |
24024 | S2(M) = 0.D0 | |
24025 | 20 CONTINUE | |
24026 | ||
24027 | DO 60 I2=1,NPOINT | |
24028 | Z2 = (1.D0-Z1)*ABSZ(I2) | |
24029 | X2 = EXP(ALN*Z2) | |
24030 | FAXX = AH/(X1*X2) | |
24031 | W = SQRT(1.D0-FAXX) | |
24032 | W1 = FAXX/(1.+W) | |
24033 | WLOG = LOG(W1) | |
24034 | FWW = FAXX*WLOG/W | |
24035 | DO 30 M=-1,9 | |
24036 | S(M) = 0.D0 | |
24037 | 30 CONTINUE | |
24038 | ||
24039 | DO 40 I=1,NPOINT | |
24040 | Z = ABSZ(I) | |
24041 | VA =-0.5D0*W1/(W1+Z*W) | |
24042 | UA =-1.D0-VA | |
24043 | VB =-0.5D0*FAXX/(W1+2.D0*W*Z) | |
24044 | UB =-1.D0-VB | |
24045 | VC =-EXP(HLN+Z*WLOG) | |
24046 | UC =-1.D0-VC | |
24047 | VE =-0.5D0*(1.D0+W)+Z*W | |
24048 | UE =-1.D0-VE | |
24049 | S(1) = S(1)+(1.+W)*2.25*(VA*VA*(3.-UA*VA-VA/(UA*UA))-UA)* | |
24050 | & WEIG(I) | |
24051 | S(2) = S(2)+(VC*VC+UC*UC)*((16./27.)/UC-(4./3.)*VC)*FWW* | |
24052 | & WEIG(I) | |
24053 | S(3) = S(3)+(1.+W)*(1.+UA*UA)*(1.-(4./9.)*VA*VA/UA)*WEIG(I) | |
24054 | S(5) = S(5)+((4./9.)*(1.+UB*UB+(UB*UB+VB*VB)*VB*VB)- | |
24055 | & (8./27.)*UA*UA*VA)*WEIG(I) | |
24056 | S(6) = S(6)+(4./9.)*(UE*UE+VE*VE)*FAXX*WEIG(I) | |
24057 | S(7) = S(7)+(1.+W)*((2./9.)*(1.+UA*UA+(1.+VA*VA)*VA*VA/ | |
24058 | & (UA*UA))-(4./27.)*VA/UA)*WEIG(I) | |
24059 | S(8) = S(8)+(4./9.)*(1.+UB*UB)*WEIG(I) | |
24060 | S(-1) = S(-1)+(1.+VC*VC)*(VC/(UC*UC)-(4./9.))*FWW*WEIG(I) | |
24061 | 40 CONTINUE | |
24062 | S(4) = S(2)*(9./32.) | |
24063 | DO 50 M=-1,8 | |
24064 | S2(M) = S2(M)+S(M)*WEIG(I2)*W | |
24065 | 50 CONTINUE | |
24066 | 60 CONTINUE | |
24067 | DO 70 M=-1,8 | |
24068 | S1(M) = S1(M)+S2(M)*(1.D0-Z1)*WEIG(I1) | |
24069 | 70 CONTINUE | |
24070 | 80 CONTINUE | |
24071 | S1(4) = S1(4)*NF | |
24072 | S1(6) = S1(6)*MAX(0,NF-1) | |
24073 | C | |
24074 | C direct processes | |
24075 | IF((IDPDG1.EQ.22).OR.(IDPDG1.EQ.990) | |
24076 | & .OR.(IDPDG2.EQ.22).OR.(IDPDG2.EQ.990)) THEN | |
24077 | DO 180 I1=1,NPOINT | |
24078 | Z2 = ABSZ(I1) | |
24079 | X2 = EXP(ALN*Z2) | |
24080 | FAXX = AH/X2 | |
24081 | W = SQRT(1.D0-FAXX) | |
24082 | W1 = FAXX/(1.D0+W) | |
24083 | WLOG = LOG(W1) | |
24084 | WL = LOG(FAXX/(1.D0+W)**2) | |
24085 | FWW1 = FAXX*WL/ALN | |
24086 | FWW2 = FAXX*WLOG/ALN | |
24087 | DO 130 M=10,12 | |
24088 | S(M) = 0.D0 | |
24089 | 130 CONTINUE | |
24090 | C | |
24091 | DO 140 I=1,NPOINT | |
24092 | Z = ABSZ(I) | |
24093 | UA =-(1.D0+W)/2.D0*EXP(Z*WL) | |
24094 | VA =-1.D0-UA | |
24095 | VB =-EXP(HLN+Z*WLOG) | |
24096 | UB =-1.D0-VB | |
24097 | S(10) = S(10)+(8.D0/3.D0)*(1.D0+UA*UA)*WEIG(I)*FWW1 | |
24098 | S(11) = S(11)-(VB*VB+UB*UB)/UB*WEIG(I)*FWW2 | |
24099 | 140 CONTINUE | |
24100 | DO 170 M=10,11 | |
24101 | S1(M) = S1(M)+S(M)*WEIG(I1) | |
24102 | 170 CONTINUE | |
24103 | 180 CONTINUE | |
24104 | S1(12) = S1(10) | |
24105 | S1(13) = S1(11) | |
24106 | C quark charges fractions | |
24107 | IF(IDPDG1.EQ.22) THEN | |
24108 | CHRNF = 0.D0 | |
24109 | DO 100 I=1,NF | |
24110 | CHRNF = CHRNF + Q_ch2(I) | |
24111 | 100 CONTINUE | |
24112 | S1(11) = S1(11)*CHRNF | |
24113 | ELSE IF(IDPDG1.EQ.990) THEN | |
24114 | S1(11) = S1(11)*NF | |
24115 | ELSE | |
24116 | S1(11) = 0.D0 | |
24117 | ENDIF | |
24118 | IF(IDPDG2.EQ.22) THEN | |
24119 | CHRNF = 0.D0 | |
24120 | DO 200 I=1,NF | |
24121 | CHRNF = CHRNF + Q_ch2(I) | |
24122 | 200 CONTINUE | |
24123 | S1(13) = S1(13)*CHRNF | |
24124 | ELSE IF(IDPDG2.EQ.990) THEN | |
24125 | S1(13) = S1(13)*NF | |
24126 | ELSE | |
24127 | S1(13) = 0.D0 | |
24128 | ENDIF | |
24129 | ENDIF | |
24130 | C | |
24131 | C global factors | |
24132 | FFF = PI*GEV2MB*ALN*ALN/(AH*SS) | |
24133 | DO 90 M=-1,Max_pro_2 | |
24134 | Hfac(M) = MAX(FFF*F124(M)*S1(M),0.D0) | |
24135 | 90 CONTINUE | |
24136 | C | |
24137 | C double direct process | |
24138 | IF(((IDPDG1.EQ.22).OR.(IDPDG1.EQ.990)) | |
24139 | & .AND.((IDPDG2.EQ.22).OR.(IDPDG2.EQ.990))) THEN | |
24140 | FAC = 0.D0 | |
24141 | DO 300 I=1,NF | |
24142 | IF(IDPDG1.EQ.22) THEN | |
24143 | F1 = Q_ch2(I) | |
24144 | ELSE | |
24145 | F1 = 1.D0 | |
24146 | ENDIF | |
24147 | IF(IDPDG2.EQ.22) THEN | |
24148 | F2 = Q_ch2(I) | |
24149 | ELSE | |
24150 | F2 = 1.D0 | |
24151 | ENDIF | |
24152 | FAC = FAC+F1*F2*3.D0 | |
24153 | 300 CONTINUE | |
24154 | ZZ = SQRT(1.D0-4.D0*PTCUT*PTCUT/SS) | |
24155 | Hfac(14) = 4.D0*PI/SS*(LOG((1.D0+ZZ)/(1.D0-ZZ))-ZZ) | |
24156 | & *GEV2MB*FAC | |
24157 | ENDIF | |
24158 | END | |
24159 | ||
24160 | *$ CREATE PHO_HARWGX.FOR | |
24161 | *COPY PHO_HARWGX | |
24162 | CDECK ID>, PHO_HARWGX | |
24163 | SUBROUTINE PHO_HARWGX(PTCUT,ECM) | |
24164 | C********************************************************************** | |
24165 | C | |
24166 | C find maximum of remaining weight for MC sampling | |
24167 | C | |
24168 | C input: PTCUT transverse momentum cutoff | |
24169 | C ECM cms energy | |
24170 | C | |
24171 | C output: HWgx(-1:Max_pro_2) field for sampling hard processes | |
24172 | C | |
24173 | C********************************************************************** | |
24174 | IMPLICIT DOUBLE PRECISION (A-H,O-Z) | |
24175 | SAVE | |
24176 | ||
24177 | PARAMETER ( NKM = 10 ) | |
24178 | PARAMETER ( TINY = 1.D-20 ) | |
24179 | ||
24180 | C input/output channels | |
24181 | INTEGER LI,LO | |
24182 | COMMON /POINOU/ LI,LO | |
24183 | C event debugging information | |
24184 | INTEGER NMAXD | |
24185 | PARAMETER (NMAXD=100) | |
24186 | INTEGER IDEB,KSPOM,KHPOM,KSREG,KHDIR,KACCEP,KSTRG,KHTRG,KSLOO, | |
24187 | & KHLOO,KSDPO,KHDPO,KEVENT,KSOFT,KHARD | |
24188 | COMMON /PODEBG/ IDEB(NMAXD),KSPOM,KHPOM,KSREG,KHDIR,KACCEP,KSTRG, | |
24189 | & KHTRG,KSLOO,KHLOO,KSDPO,KHDPO,KEVENT,KSOFT,KHARD | |
24190 | C data on most recent hard scattering | |
24191 | INTEGER IA,IB,IC,ID,IV1,IV2,MSPR,IREJSC | |
24192 | DOUBLE PRECISION PTWANT,AS,AH,ALNS,ALNH,Z1MAX,Z1DIF,Z2MAX,Z2DIF, | |
24193 | & PT,PTfin,ETAC,ETAD,X1,X2,V,U,W,W1,AXX,QQPD,QQAL, | |
24194 | & PDF1,PDF2,WEIGHT,PHI1,PHI2,PHO1,PHO2 | |
24195 | COMMON /POCKIN/ PTWANT,AS,AH,ALNS,ALNH,Z1MAX,Z1DIF,Z2MAX,Z2DIF, | |
24196 | & PT,PTfin,ETAC,ETAD,X1,X2,V,U,W,W1,AXX, | |
24197 | & QQPD,QQAL,PDF1(-6:6),PDF2(-6:6),WEIGHT, | |
24198 | & PHI1(5),PHI2(5),PHO1(5),PHO2(5), | |
24199 | & IA,IB,IC,ID,IV1,IV2,MSPR,IREJSC | |
24200 | C hard cross sections and MC selection weights | |
24201 | INTEGER Max_pro_2 | |
24202 | PARAMETER ( Max_pro_2 = 16 ) | |
24203 | INTEGER IHa_last,IHb_last,MH_pro_on,MH_tried, | |
24204 | & MH_acc_1,MH_acc_2 | |
24205 | DOUBLE PRECISION Hfac,HWgx,HSig,Hdpt,HEcm_last,HQ2a_last,HQ2b_last | |
24206 | COMMON /POHRCS/ Hfac(-1:Max_pro_2),HWgx(-1:Max_pro_2), | |
24207 | & HSig(-1:Max_pro_2),Hdpt(-1:Max_pro_2), | |
24208 | & HEcm_last,HQ2a_last,HQ2b_last,IHa_last,IHb_last, | |
24209 | & MH_pro_on(-1:Max_pro_2,0:4),MH_tried(-1:Max_pro_2,0:4), | |
24210 | & MH_acc_1(-1:Max_pro_2,0:4),MH_acc_2(-1:Max_pro_2,0:4) | |
24211 | ||
24212 | DIMENSION Z(3),D(3),FF(0:NKM),PDA(-6:6),PDB(-6:6),XM1(NKM), | |
24213 | & XM2(NKM),PTM(NKM),ZMX(3,NKM),DMX(3,NKM),IMX(NKM),IPO(NKM) | |
24214 | DIMENSION IFTAB(-1:Max_pro_2) | |
24215 | DATA IFTAB / 4,0,1,2,4,1,2,2,3,5,0,6,7,8,9,10,0,10 / | |
24216 | ||
24217 | C initial settings | |
24218 | AH = (2.D0*PTCUT/ECM)**2 | |
24219 | ALNH = LOG(AH) | |
24220 | FF(0) = 0.D0 | |
24221 | DO 22 I=1,NKM | |
24222 | FF(I) = 0.D0 | |
24223 | XM1(I) = 0.D0 | |
24224 | XM2(I) = 0.D0 | |
24225 | PTM(I) = 0.D0 | |
24226 | ZMX(1,I) = 0.D0 | |
24227 | ZMX(2,I) = 0.D0 | |
24228 | ZMX(3,I) = 0.D0 | |
24229 | DMX(1,I) = 0.D0 | |
24230 | DMX(2,I) = 0.D0 | |
24231 | DMX(3,I) = 0.D0 | |
24232 | IMX(I) = 0 | |
24233 | IPO(I) = 0 | |
24234 | 22 CONTINUE | |
24235 | ||
24236 | NKML = 10 | |
24237 | DO 40 NKON=1,NKML | |
24238 | ||
24239 | DO 50 IST=1,3 | |
24240 | C start configuration | |
24241 | IF(IST.EQ.1) THEN | |
24242 | Z(1) = MIN(0.999D0,LOG(0.5D0)/LOG(AH)) | |
24243 | Z(2) = 0.5 | |
24244 | Z(3) = 0.1 | |
24245 | D(1) =-0.5 | |
24246 | D(2) = 0.5 | |
24247 | D(3) = 0.5 | |
24248 | ELSE IF(IST.EQ.2) THEN | |
24249 | Z(1) = 0.999D0 | |
24250 | Z(2) = 0.5 | |
24251 | Z(3) = 0.0 | |
24252 | D(1) =-0.5 | |
24253 | D(2) = 0.5 | |
24254 | D(3) = 0.5 | |
24255 | ELSE IF(IST.EQ.3) THEN | |
24256 | Z(1) = MIN(0.999D0,LOG(0.5D0)/LOG(AH)) | |
24257 | Z(2) = 0.1 | |
24258 | Z(3) = 0.1 | |
24259 | D(1) =-0.5 | |
24260 | D(2) = 0.5 | |
24261 | D(3) = 0.5 | |
24262 | ELSE IF(IST.EQ.4) THEN | |
24263 | Z(1) = MIN(0.999D0,LOG(0.5D0)/LOG(AH)) | |
24264 | Z(2) = 0.9 | |
24265 | Z(3) = 0.1 | |
24266 | D(1) =-0.5 | |
24267 | D(2) = 0.5 | |
24268 | D(3) = 0.5 | |
24269 | ENDIF | |
24270 | IT = 0 | |
24271 | CALL PHO_HARWGI(ECM,PTCUT,NKON,Z,F2) | |
24272 | C process possible? | |
24273 | IF(F2.LE.0.D0) GOTO 35 | |
24274 | ||
24275 | 10 CONTINUE | |
24276 | IT = IT+1 | |
24277 | FOLD = F2 | |
24278 | DO 30 I=1,3 | |
24279 | D(I) = D(I)/5.D0 | |
24280 | Z(I) = Z(I)+D(I) | |
24281 | CALL PHO_HARWGI(ECM,PTCUT,NKON,Z,F3) | |
24282 | IF ( F2.GT.F3 ) Z(I) = Z(I)-D(I) | |
24283 | IF ( F2.GT.F3 ) D(I) =-D(I) | |
24284 | 20 CONTINUE | |
24285 | F1 = MIN(F2,F3) | |
24286 | F2 = MAX(F2,F3) | |
24287 | Z(I) = Z(I)+D(I) | |
24288 | CALL PHO_HARWGI(ECM,PTCUT,NKON,Z,F3) | |
24289 | IF ( F3.GT.F2 ) GOTO 20 | |
24290 | ZZ = Z(I)-D(I) | |
24291 | Z(I) = ZZ+0.5*D(I)*(F3-F1)/MAX(TINY,F2+F2-F1-F3) | |
24292 | IF ( ABS(ZZ-Z(I)).GT.D(I)*0.1D0 ) | |
24293 | & CALL PHO_HARWGI(ECM,PTCUT,NKON,Z,F1) | |
24294 | IF ( F1.LE.F2 ) Z(I) = ZZ | |
24295 | F2 = MAX(F1,F2) | |
24296 | 30 CONTINUE | |
24297 | IF((ABS(FOLD-F2)/MAX(TINY,F2).GT.0.002D0).OR.(IT.LT.3)) GOTO 10 | |
24298 | ||
24299 | IF(F2.GT.FF(NKON)) THEN | |
24300 | FF(NKON) = MAX(F2,0.D0) | |
24301 | XM1(NKON) = X1 | |
24302 | XM2(NKON) = X2 | |
24303 | PTM(NKON) = PT | |
24304 | ZMX(1,NKON) = Z(1) | |
24305 | ZMX(2,NKON) = Z(2) | |
24306 | ZMX(3,NKON) = Z(3) | |
24307 | DMX(1,NKON) = D(1) | |
24308 | DMX(2,NKON) = D(2) | |
24309 | DMX(3,NKON) = D(3) | |
24310 | IMX(NKON) = IT | |
24311 | IPO(NKON) = IST | |
24312 | ENDIF | |
24313 | C | |
24314 | 50 CONTINUE | |
24315 | 35 CONTINUE | |
24316 | 40 CONTINUE | |
24317 | ||
24318 | C debug output | |
24319 | IF(IDEB(38).GE.5) THEN | |
24320 | WRITE(LO,'(/1X,A)') | |
24321 | & 'PHO_HARWGX: maximum of weight (I,IT,IS,FF,Z(1-3),D(1-3))' | |
24322 | DO 60 I=1,NKM | |
24323 | IF(IMX(I).NE.0) WRITE(LO,'(1X,I2,I3,I2,7E10.3)') I,IMX(I), | |
24324 | & IPO(I),FF(I),ZMX(1,I),ZMX(2,I),ZMX(3,I),DMX(1,I), | |
24325 | & DMX(2,I),DMX(3,I) | |
24326 | 60 CONTINUE | |
24327 | ENDIF | |
24328 | ||
24329 | DO 70 I=-1,Max_pro_2 | |
24330 | HWgx(I) = MAX(FF(IFTAB(I))*Hfac(I),0.D0) | |
24331 | 70 CONTINUE | |
24332 | ||
24333 | C debug output | |
24334 | IF(IDEB(38).GE.5) THEN | |
24335 | WRITE(LO,'(/1X,A)') 'PHO_HARWGX: total weights' | |
24336 | WRITE(LO,'(5X,A)') 'I X1 X2 PT HWgx(I) FDIS' | |
24337 | DO 80 I=-1,Max_pro_2 | |
24338 | IF((IFTAB(I).NE.0).AND.(HWgx(I).GT.0.D0)) THEN | |
24339 | MSPR = I | |
24340 | X1 = MIN(XM1(IFTAB(I)),0.9999999999D0) | |
24341 | X2 = MIN(XM2(IFTAB(I)),0.9999999999D0) | |
24342 | PT = PTM(IFTAB(I)) | |
24343 | CALL PHO_HARWGH(PDS,PDA,PDB,FDIS) | |
24344 | WRITE(LO,'(1X,I3,5E12.3)') I,X1,X2,PT,HWgx(I),FDIS | |
24345 | ENDIF | |
24346 | 80 CONTINUE | |
24347 | ENDIF | |
24348 | ||
24349 | END | |
24350 | ||
24351 | *$ CREATE PHO_HARWGI.FOR | |
24352 | *COPY PHO_HARWGI | |
24353 | CDECK ID>, PHO_HARWGI | |
24354 | SUBROUTINE PHO_HARWGI(ECMX,PTCUT,NKON,Z,FDIS) | |
24355 | C********************************************************************** | |
24356 | C | |
24357 | C auxiliary subroutine to find maximum of remaining weight | |
24358 | C | |
24359 | C input: ECMX current CMS energy | |
24360 | C PTCUT current pt cutoff | |
24361 | C NKON process label 1..5 resolved | |
24362 | C 6..7 direct particle 1 | |
24363 | C 8..9 direct particle 2 | |
24364 | C 10 double direct | |
24365 | C Z(3) transformed variable | |
24366 | C | |
24367 | C output: remaining weight | |
24368 | C | |
24369 | C********************************************************************** | |
24370 | IMPLICIT DOUBLE PRECISION (A-H,O-Z) | |
24371 | SAVE | |
24372 | ||
24373 | DIMENSION Z(3) | |
24374 | ||
24375 | PARAMETER ( NKM = 10 ) | |
24376 | PARAMETER ( TINY = 1.D-30, | |
24377 | & TINY6 = 1.D-06 ) | |
24378 | ||
24379 | C input/output channels | |
24380 | INTEGER LI,LO | |
24381 | COMMON /POINOU/ LI,LO | |
24382 | C event debugging information | |
24383 | INTEGER NMAXD | |
24384 | PARAMETER (NMAXD=100) | |
24385 | INTEGER IDEB,KSPOM,KHPOM,KSREG,KHDIR,KACCEP,KSTRG,KHTRG,KSLOO, | |
24386 | & KHLOO,KSDPO,KHDPO,KEVENT,KSOFT,KHARD | |
24387 | COMMON /PODEBG/ IDEB(NMAXD),KSPOM,KHPOM,KSREG,KHDIR,KACCEP,KSTRG, | |
24388 | & KHTRG,KSLOO,KHLOO,KSDPO,KHDPO,KEVENT,KSOFT,KHARD | |
24389 | C model switches and parameters | |
24390 | CHARACTER*8 MDLNA | |
24391 | INTEGER ISWMDL,IPAMDL | |
24392 | DOUBLE PRECISION PARMDL | |
24393 | COMMON /POMDLS/ MDLNA(50),ISWMDL(50),PARMDL(400),IPAMDL(400) | |
24394 | C data of c.m. system of Pomeron / Reggeon exchange | |
24395 | INTEGER NPOSP,IDPDG1,IDBAM1,IDPDG2,IDBAM2 | |
24396 | DOUBLE PRECISION ECMP,PCMP,PMASSP,PVIRTP,GAMBEP, | |
24397 | & SIDP,CODP,SIFP,COFP | |
24398 | COMMON /POPCMS/ ECMP,PCMP,PMASSP(2),PVIRTP(2),GAMBEP(4), | |
24399 | & SIDP,CODP,SIFP,COFP,NPOSP(2), | |
24400 | & IDPDG1,IDBAM1,IDPDG2,IDBAM2 | |
24401 | C currently activated parton density parametrizations | |
24402 | CHARACTER*8 PDFNAM | |
24403 | INTEGER IPARID,IPAVA,ITYPE,IGRP,ISET,IEXT,NPAOLD | |
24404 | DOUBLE PRECISION PDFLAM,PDFQ2M | |
24405 | COMMON /POPPDF/ PDFLAM(2),PDFQ2M(2),PDFNAM(2),IPARID(2), | |
24406 | & IPAVA(2),ITYPE(2),IGRP(2),ISET(2),IEXT(2),NPAOLD | |
24407 | C hard scattering parameters used for most recent hard interaction | |
24408 | INTEGER NFbeta,NF | |
24409 | DOUBLE PRECISION ALQCD2,BQCD | |
24410 | COMMON /POHAPA/ ALQCD2(3,4),BQCD(4),NFbeta,NF | |
24411 | C some hadron information, will be deleted in future versions | |
24412 | INTEGER NFS | |
24413 | DOUBLE PRECISION QMASS,BET,PCOUDI,PNORM,VALPRG | |
24414 | COMMON /POHDRN/ QMASS(6),BET,PCOUDI,PNORM,VALPRG(2),NFS | |
24415 | C scale parameters for parton model calculations | |
24416 | INTEGER NQQAL,NQQALI,NQQALF,NQQPD | |
24417 | DOUBLE PRECISION AQQAL,AQQALI,AQQALF,AQQPD | |
24418 | COMMON /POHSCL/ AQQAL,AQQALI,AQQALF,AQQPD, | |
24419 | & NQQAL,NQQALI,NQQALF,NQQPD | |
24420 | C data on most recent hard scattering | |
24421 | INTEGER IA,IB,IC,ID,IV1,IV2,MSPR,IREJSC | |
24422 | DOUBLE PRECISION PTWANT,AS,AH,ALNS,ALNH,Z1MAX,Z1DIF,Z2MAX,Z2DIF, | |
24423 | & PT,PTfin,ETAC,ETAD,X1,X2,V,U,W,W1,AXX,QQPD,QQAL, | |
24424 | & PDF1,PDF2,WEIGHT,PHI1,PHI2,PHO1,PHO2 | |
24425 | COMMON /POCKIN/ PTWANT,AS,AH,ALNS,ALNH,Z1MAX,Z1DIF,Z2MAX,Z2DIF, | |
24426 | & PT,PTfin,ETAC,ETAD,X1,X2,V,U,W,W1,AXX, | |
24427 | & QQPD,QQAL,PDF1(-6:6),PDF2(-6:6),WEIGHT, | |
24428 | & PHI1(5),PHI2(5),PHO1(5),PHO2(5), | |
24429 | & IA,IB,IC,ID,IV1,IV2,MSPR,IREJSC | |
24430 | ||
24431 | DOUBLE PRECISION PHO_ALPHAS,pho_alphae | |
24432 | DIMENSION F(NKM),PDA(-6:6),PDB(-6:6) | |
24433 | ||
24434 | FDIS = 0.D0 | |
24435 | ||
24436 | IF(IDEB(64).GE.25) WRITE(LO,'(1X,A,/5X,5E12.3,I5)') | |
24437 | & 'PHO_HARWGI: ECM,PT,Z,NK',ECMX,PTCUT,Z,NKON | |
24438 | C check input values | |
24439 | IF ( Z(1).LT.0.D0 .OR. Z(1).GT.1.D0 ) RETURN | |
24440 | IF ( Z(2).LT.0.D0 .OR. Z(2).GT.1.D0 ) RETURN | |
24441 | IF ( Z(3).LT.0.D0 .OR. Z(3).GT.1.D0 ) RETURN | |
24442 | C transformations | |
24443 | Y1 = EXP(ALNH*Z(1)) | |
24444 | IF(NKON.LE.5) THEN | |
24445 | C resolved kinematic | |
24446 | Y2 =-(1.D0-Y1)+2.D0*(1.D0-Y1)*Z(2) | |
24447 | X1 = 0.5D0*(Y2+SQRT(Y2*Y2+4.D0*Y1)) | |
24448 | X2 = X1-Y2 | |
24449 | X1 = MIN(X1,0.999999999999D0) | |
24450 | X2 = MIN(X2,0.999999999999D0) | |
24451 | ELSE IF(NKON.LE.7) THEN | |
24452 | C direct kinematic 1 | |
24453 | X1 = 1.D0 | |
24454 | X2 = MIN(Y1,0.999999999999D0) | |
24455 | ELSE IF(NKON.LE.9) THEN | |
24456 | C direct kinematic 2 | |
24457 | X1 = MIN(Y1,0.999999999999D0) | |
24458 | X2 = 1.D0 | |
24459 | ELSE | |
24460 | C double direct kinematic | |
24461 | X1 = 1.D0 | |
24462 | X2 = 1.D0 | |
24463 | ENDIF | |
24464 | W = SQRT(MAX(TINY,1.D0-AH/Y1)) | |
24465 | V =-0.5D0+W*(Z(3)-0.5D0) | |
24466 | U =-(1.D0+V) | |
24467 | PT = MAX(SQRT(U*V*Y1*ECMX*ECMX),PTCUT) | |
24468 | ||
24469 | C set hard scale QQ for alpha and partondistr. | |
24470 | IF ( NQQAL.EQ.1 ) THEN | |
24471 | QQAL = AQQAL*PT*PT | |
24472 | ELSEIF ( NQQAL.EQ.2 ) THEN | |
24473 | QQAL = AQQAL*Y1*ECMX*ECMX*U*V/(1.+V*V+U*U) | |
24474 | ELSEIF ( NQQAL.EQ.3 ) THEN | |
24475 | QQAL = AQQAL*Y1*ECMX*ECMX | |
24476 | ELSEIF ( NQQAL.EQ.4 ) THEN | |
24477 | QQAL = AQQAL*Y1*ECMX*ECMX*(U*V)**(1./3.) | |
24478 | ENDIF | |
24479 | IF ( NQQPD.EQ.1 ) THEN | |
24480 | QQPD = AQQPD*PT*PT | |
24481 | ELSEIF ( NQQPD.EQ.2 ) THEN | |
24482 | QQPD = AQQPD*Y1*ECMX*ECMX*U*V/(1.+V*V+U*U) | |
24483 | ELSEIF ( NQQPD.EQ.3 ) THEN | |
24484 | QQPD = AQQPD*Y1*ECMX*ECMX | |
24485 | ELSEIF ( NQQPD.EQ.4 ) THEN | |
24486 | QQPD = AQQPD*Y1*ECMX*ECMX*(U*V)**(1./3.) | |
24487 | ENDIF | |
24488 | C | |
24489 | IF(NKON.LE.5) THEN | |
24490 | DO 10 N=1,5 | |
24491 | F(N) = 0.D0 | |
24492 | 10 CONTINUE | |
24493 | C resolved processes | |
24494 | ALPHA1 = PHO_ALPHAS(QQAL,3) | |
24495 | ALPHA2 = ALPHA1 | |
24496 | CALL PHO_PDF(1,X1,QQPD,0.D0,PDA) | |
24497 | CALL PHO_PDF(2,X2,QQPD,0.D0,PDB) | |
24498 | C calculate full distribution FDIS | |
24499 | DO 20 I=1,NF | |
24500 | F(2) = F(2)+PDA(I)*PDB(-I)+PDA(-I)*PDB( I) | |
24501 | F(3) = F(3)+PDA(I)*PDB( I)+PDA(-I)*PDB(-I) | |
24502 | F(4) = F(4)+PDA(I)+PDA(-I) | |
24503 | F(5) = F(5)+PDB(I)+PDB(-I) | |
24504 | 20 CONTINUE | |
24505 | F(1) = PDA(0)*PDB(0) | |
24506 | T = PDA(0)*F(5)+PDB(0)*F(4) | |
24507 | F(5) = F(4)*F(5)-(F(2)+F(3)) | |
24508 | F(4) = T | |
24509 | ELSE IF(NKON.LE.7) THEN | |
24510 | C direct processes particle 1 | |
24511 | IF(IDPDG1.EQ.22) THEN | |
24512 | ALPHA1 = pho_alphae(QQAL) | |
24513 | CH1 = 4.D0/9.D0 | |
24514 | CH2 = 3.D0/9.D0 | |
24515 | ELSE IF(IDPDG1.EQ.990) THEN | |
24516 | ALPHA1 = PARMDL(74) | |
24517 | CH1 = 1.D0 | |
24518 | CH2 = 0.D0 | |
24519 | ELSE | |
24520 | FDIS = -1.D0 | |
24521 | RETURN | |
24522 | ENDIF | |
24523 | ALPHA2 = PHO_ALPHAS(QQAL,2) | |
24524 | CALL PHO_PDF(2,X2,QQPD,0.D0,PDB) | |
24525 | F(6) = 0.D0 | |
24526 | DO 30 I=1,NF | |
24527 | F(6) = F(6)+(PDB(I)+PDB(-I))*(CH1-CH2*MOD(I,2)) | |
24528 | 30 CONTINUE | |
24529 | F(7) = PDB(0) | |
24530 | ELSE IF(NKON.LE.9) THEN | |
24531 | C direct processes particle 2 | |
24532 | ALPHA1 = PHO_ALPHAS(QQAL,1) | |
24533 | IF(IDPDG2.EQ.22) THEN | |
24534 | ALPHA2 = pho_alphae(QQAL) | |
24535 | CH1 = 4.D0/9.D0 | |
24536 | CH2 = 3.D0/9.D0 | |
24537 | ELSE IF(IDPDG2.EQ.990) THEN | |
24538 | ALPHA2 = PARMDL(74) | |
24539 | CH1 = 1.D0 | |
24540 | CH2 = 0.D0 | |
24541 | ELSE | |
24542 | FDIS = -1.D0 | |
24543 | RETURN | |
24544 | ENDIF | |
24545 | CALL PHO_PDF(1,X1,QQPD,0.D0,PDA) | |
24546 | F(8) = 0.D0 | |
24547 | DO 40 I=1,NF | |
24548 | F(8) = F(8)+(PDA(I)+PDA(-I))*(CH1-CH2*MOD(I,2)) | |
24549 | 40 CONTINUE | |
24550 | F(9) = PDA(0) | |
24551 | ELSE | |
24552 | C double direct process | |
24553 | SSR = ECMX*ECMX | |
24554 | IF(IDPDG1.EQ.22) THEN | |
24555 | ALPHA1 = pho_alphae(SSR) | |
24556 | ELSE IF(IDPDG1.EQ.990) THEN | |
24557 | ALPHA1 = PARMDL(74) | |
24558 | ELSE | |
24559 | FDIS = -1.D0 | |
24560 | RETURN | |
24561 | ENDIF | |
24562 | IF(IDPDG2.EQ.22) THEN | |
24563 | ALPHA2 = pho_alphae(SSR) | |
24564 | ELSE IF(IDPDG2.EQ.990) THEN | |
24565 | ALPHA2 = PARMDL(74) | |
24566 | ELSE | |
24567 | FDIS = -1.D0 | |
24568 | RETURN | |
24569 | ENDIF | |
24570 | F(10) = 1.D0 | |
24571 | ENDIF | |
24572 | ||
24573 | FDIS = MAX(0.D0,F(NKON)*ALPHA1*ALPHA2) | |
24574 | ||
24575 | C debug output | |
24576 | IF(IDEB(64).GE.20) WRITE(LO,'(1X,A,/2X,I3,2I6,7E11.3)') | |
24577 | & 'PHO_HARWGI: NKON,ID1,ID2,AL1,AL2,X1,X2,PT,F(NKON),FDIS', | |
24578 | & NKON,IDPDG1,IDPDG2,ALPHA1,ALPHA2,X1,X2,PT,F(NKON),FDIS | |
24579 | ||
24580 | END | |
24581 | ||
24582 | *$ CREATE PHO_HARINI.FOR | |
24583 | *COPY PHO_HARINI | |
24584 | CDECK ID>, PHO_HARINI | |
24585 | SUBROUTINE PHO_HARINI(IP,IDP1,IDP2,PV1,PV2,NOUT,MODE) | |
24586 | C********************************************************************** | |
24587 | C | |
24588 | C initialize calculation of hard cross section | |
24589 | C | |
24590 | C must not be called during MC generation | |
24591 | C | |
24592 | C*********************************************************************** | |
24593 | IMPLICIT DOUBLE PRECISION (A-H,O-Z) | |
24594 | SAVE | |
24595 | ||
24596 | PARAMETER ( DEPS = 1.D-10 ) | |
24597 | ||
24598 | C input/output channels | |
24599 | INTEGER LI,LO | |
24600 | COMMON /POINOU/ LI,LO | |
24601 | C event debugging information | |
24602 | INTEGER NMAXD | |
24603 | PARAMETER (NMAXD=100) | |
24604 | INTEGER IDEB,KSPOM,KHPOM,KSREG,KHDIR,KACCEP,KSTRG,KHTRG,KSLOO, | |
24605 | & KHLOO,KSDPO,KHDPO,KEVENT,KSOFT,KHARD | |
24606 | COMMON /PODEBG/ IDEB(NMAXD),KSPOM,KHPOM,KSREG,KHDIR,KACCEP,KSTRG, | |
24607 | & KHTRG,KSLOO,KHLOO,KSDPO,KHDPO,KEVENT,KSOFT,KHARD | |
24608 | C model switches and parameters | |
24609 | CHARACTER*8 MDLNA | |
24610 | INTEGER ISWMDL,IPAMDL | |
24611 | DOUBLE PRECISION PARMDL | |
24612 | COMMON /POMDLS/ MDLNA(50),ISWMDL(50),PARMDL(400),IPAMDL(400) | |
24613 | C currently activated parton density parametrizations | |
24614 | CHARACTER*8 PDFNAM | |
24615 | INTEGER IPARID,IPAVA,ITYPE,IGRP,ISET,IEXT,NPAOLD | |
24616 | DOUBLE PRECISION PDFLAM,PDFQ2M | |
24617 | COMMON /POPPDF/ PDFLAM(2),PDFQ2M(2),PDFNAM(2),IPARID(2), | |
24618 | & IPAVA(2),ITYPE(2),IGRP(2),ISET(2),IEXT(2),NPAOLD | |
24619 | C some constants | |
24620 | DOUBLE PRECISION PI,PI2,PI4,GEV2MB,Q_ch,Q_ch2,Q_ch4 | |
24621 | COMMON /POCONS/ PI,PI2,PI4,GEV2MB, | |
24622 | & Q_ch(-6:6),Q_ch2(-6:6),Q_ch4(-6:6) | |
24623 | C scale parameters for parton model calculations | |
24624 | INTEGER NQQAL,NQQALI,NQQALF,NQQPD | |
24625 | DOUBLE PRECISION AQQAL,AQQALI,AQQALF,AQQPD | |
24626 | COMMON /POHSCL/ AQQAL,AQQALI,AQQALF,AQQPD, | |
24627 | & NQQAL,NQQALI,NQQALF,NQQPD | |
24628 | C data of c.m. system of Pomeron / Reggeon exchange | |
24629 | INTEGER NPOSP,IDPDG1,IDBAM1,IDPDG2,IDBAM2 | |
24630 | DOUBLE PRECISION ECMP,PCMP,PMASSP,PVIRTP,GAMBEP, | |
24631 | & SIDP,CODP,SIFP,COFP | |
24632 | COMMON /POPCMS/ ECMP,PCMP,PMASSP(2),PVIRTP(2),GAMBEP(4), | |
24633 | & SIDP,CODP,SIFP,COFP,NPOSP(2), | |
24634 | & IDPDG1,IDBAM1,IDPDG2,IDBAM2 | |
24635 | C obsolete cut-off information | |
24636 | DOUBLE PRECISION PTCUT,PTANO,FPS,FPH,PSOMIN,XSOMIN | |
24637 | COMMON /POCUT1/ PTCUT(4),PTANO(4),FPS(4),FPH(4),PSOMIN,XSOMIN | |
24638 | C hard scattering parameters used for most recent hard interaction | |
24639 | INTEGER NFbeta,NF | |
24640 | DOUBLE PRECISION ALQCD2,BQCD | |
24641 | COMMON /POHAPA/ ALQCD2(3,4),BQCD(4),NFbeta,NF | |
24642 | ||
24643 | double precision pho_alphas | |
24644 | ||
24645 | CHARACTER*20 RFLAG | |
24646 | ||
24647 | C set local Pomeron c.m. system data | |
24648 | IDPDG1 = IDP1 | |
24649 | IDPDG2 = IDP2 | |
24650 | PVIRTP(1) = PV1 | |
24651 | PVIRTP(2) = PV2 | |
24652 | C initialize PDFs | |
24653 | CALL PHO_ACTPDF(IDPDG1,1) | |
24654 | CALL PHO_ACTPDF(IDPDG2,2) | |
24655 | C initialize alpha_s calculation | |
24656 | DUMMY = PHO_ALPHAS(0.D0,-4) | |
24657 | C initialize scales with defaults | |
24658 | IF((IDPDG1.EQ.22).OR.(IDPDG1.EQ.990)) THEN | |
24659 | IF((IDPDG2.EQ.22).OR.(IDPDG2.EQ.990)) THEN | |
24660 | AQQAL = PARMDL(83) | |
24661 | AQQALI = PARMDL(86) | |
24662 | AQQALF = PARMDL(89) | |
24663 | AQQPD = PARMDL(92) | |
24664 | NQQAL = IPAMDL(83) | |
24665 | NQQALI = IPAMDL(86) | |
24666 | NQQALF = IPAMDL(89) | |
24667 | NQQPD = IPAMDL(92) | |
24668 | ELSE | |
24669 | AQQAL = PARMDL(82) | |
24670 | AQQALI = PARMDL(85) | |
24671 | AQQALF = PARMDL(88) | |
24672 | AQQPD = PARMDL(91) | |
24673 | NQQAL = IPAMDL(82) | |
24674 | NQQALI = IPAMDL(85) | |
24675 | NQQALF = IPAMDL(88) | |
24676 | NQQPD = IPAMDL(91) | |
24677 | ENDIF | |
24678 | ELSE IF((IDPDG2.EQ.22).OR.(IDPDG2.EQ.990)) THEN | |
24679 | AQQAL = PARMDL(82) | |
24680 | AQQALI = PARMDL(85) | |
24681 | AQQALF = PARMDL(88) | |
24682 | AQQPD = PARMDL(91) | |
24683 | NQQAL = IPAMDL(82) | |
24684 | NQQALI = IPAMDL(85) | |
24685 | NQQALF = IPAMDL(88) | |
24686 | NQQPD = IPAMDL(91) | |
24687 | ELSE | |
24688 | AQQAL = PARMDL(81) | |
24689 | AQQALI = PARMDL(84) | |
24690 | AQQALF = PARMDL(87) | |
24691 | AQQPD = PARMDL(90) | |
24692 | NQQAL = IPAMDL(81) | |
24693 | NQQALI = IPAMDL(84) | |
24694 | NQQALF = IPAMDL(87) | |
24695 | NQQPD = IPAMDL(90) | |
24696 | ENDIF | |
24697 | IF(PARMDL(109+IP).LT.DEPS) PARMDL(109+IP) = AQQAL | |
24698 | IF(PARMDL(113+IP).LT.DEPS) PARMDL(113+IP) = AQQALI | |
24699 | IF(PARMDL(117+IP).LT.DEPS) PARMDL(117+IP) = AQQALF | |
24700 | IF(PARMDL(121+IP).LT.DEPS) PARMDL(121+IP) = AQQPD | |
24701 | IF(IPAMDL(64+IP).LT.0) IPAMDL(64+IP) = NQQAL | |
24702 | IF(IPAMDL(68+IP).LT.0) IPAMDL(68+IP) = NQQALI | |
24703 | IF(IPAMDL(72+IP).LT.0) IPAMDL(72+IP) = NQQALF | |
24704 | IF(IPAMDL(76+IP).LT.0) IPAMDL(76+IP) = NQQPD | |
24705 | AQQAL = PARMDL(109+IP) | |
24706 | AQQALI = PARMDL(113+IP) | |
24707 | AQQALF = PARMDL(117+IP) | |
24708 | AQQPD = PARMDL(121+IP) | |
24709 | NQQAL = IPAMDL(64+IP) | |
24710 | NQQALI = IPAMDL(68+IP) | |
24711 | NQQALF = IPAMDL(72+IP) | |
24712 | NQQPD = IPAMDL(76+IP) | |
24713 | PTCUT(1) = PARMDL(36) | |
24714 | PTCUT(2) = PARMDL(37) | |
24715 | PTCUT(3) = PARMDL(38) | |
24716 | PTCUT(4) = PARMDL(39) | |
24717 | PTANO(1) = PARMDL(130) | |
24718 | PTANO(2) = PARMDL(131) | |
24719 | PTANO(3) = PARMDL(132) | |
24720 | PTANO(4) = PARMDL(133) | |
24721 | RFLAG = '(energy-independent)' | |
24722 | IF(IPAMDL(7).GT.0) RFLAG = '(energy-dependent)' | |
24723 | ||
24724 | C write out all settings | |
24725 | IF((IDEB(66).GE.15).OR.(MODE.GT.0)) THEN | |
24726 | WRITE(NOUT,1050) IP,IDPDG1,IDPDG2,PTCUT(IP),RFLAG, | |
24727 | & PDFNAM(1),IGRP(1),ISET(1),IEXT(1), | |
24728 | & PDFNAM(2),IGRP(2),ISET(2),IEXT(2), | |
24729 | & PDFLAM,NF,NQQAL,AQQAL,NQQPD,AQQPD | |
24730 | 1050 FORMAT(/, | |
24731 | & ' PHO_HARINI: hard scattering parameters for IP:',I3/, | |
24732 | & 5X,'particle 1 / particle 2:',2I8,/, | |
24733 | & 5X,'min. PT :',F7.1,2X,A,/, | |
24734 | & 5X,'PDF side 1:',2X,A8,' IGRP/ISET/IEXT ',3I4,/, | |
24735 | & 5X,'PDF side 2:',2X,A8,' IGRP/ISET/IEXT ',3I4,/, | |
24736 | & 5X,'LAMBDA1,2 (4 active flavours):',2F8.3,/, | |
24737 | & 5X,'max. number of active flavours NF :',I3,/, | |
24738 | & 5X,'NQQAL/AQQAL/NQQPD/AQQPD:',I5,F8.3,I5,F8.3) | |
24739 | ENDIF | |
24740 | ||
24741 | END | |
24742 | ||
24743 | *$ CREATE PHO_HARINT.FOR | |
24744 | *COPY PHO_HARINT | |
24745 | CDECK ID>, PHO_HARINT | |
24746 | SUBROUTINE PHO_HARINT(IPP,ECM,P2V1,P2V2,I1,I2,K1,K2,MSPOM) | |
24747 | C********************************************************************** | |
24748 | C | |
24749 | C interpolate cross sections and weights for hard scattering | |
24750 | C | |
24751 | C input: IPP particle combination (neg. for add. user cuts) | |
24752 | C ECM CMS energy (GeV) | |
24753 | C P2V1/2 particle virtualities (pos., GeV**2) | |
24754 | C I1 first subprocess to calculate | |
24755 | C I2 last subprocess to calculate | |
24756 | C <-1 only scales and cutoffs calculated | |
24757 | C K1 first variable to calculate | |
24758 | C K2 last variable to calculate | |
24759 | C MSPOM cross sections to use for pt distribution | |
24760 | C 0 reggeon | |
24761 | C >0 pomeron | |
24762 | C | |
24763 | C for K1 < 3 the soft pt distribution is also calculated | |
24764 | C | |
24765 | C output: interpolated values in HWgx, HSig, Hdpt | |
24766 | C | |
24767 | C*********************************************************************** | |
24768 | IMPLICIT DOUBLE PRECISION (A-H,O-Z) | |
24769 | SAVE | |
24770 | ||
24771 | PARAMETER ( DEPS = 1.D-15, | |
24772 | & DEPS2 = 2.D-15 ) | |
24773 | ||
24774 | C input/output channels | |
24775 | INTEGER LI,LO | |
24776 | COMMON /POINOU/ LI,LO | |
24777 | C event debugging information | |
24778 | INTEGER NMAXD | |
24779 | PARAMETER (NMAXD=100) | |
24780 | INTEGER IDEB,KSPOM,KHPOM,KSREG,KHDIR,KACCEP,KSTRG,KHTRG,KSLOO, | |
24781 | & KHLOO,KSDPO,KHDPO,KEVENT,KSOFT,KHARD | |
24782 | COMMON /PODEBG/ IDEB(NMAXD),KSPOM,KHPOM,KSREG,KHDIR,KACCEP,KSTRG, | |
24783 | & KHTRG,KSLOO,KHLOO,KSDPO,KHDPO,KEVENT,KSOFT,KHARD | |
24784 | C model switches and parameters | |
24785 | CHARACTER*8 MDLNA | |
24786 | INTEGER ISWMDL,IPAMDL | |
24787 | DOUBLE PRECISION PARMDL | |
24788 | COMMON /POMDLS/ MDLNA(50),ISWMDL(50),PARMDL(400),IPAMDL(400) | |
24789 | C Reggeon phenomenology parameters | |
24790 | DOUBLE PRECISION ALPOM,ALPOMP,GP,B0POM,ALREG,ALREGP,GR,B0REG, | |
24791 | & GPPP,GPPR,B0PPP,B0PPR,VDMFAC,VDMQ2F,B0HAR,AKFAC | |
24792 | COMMON /POPREG/ ALPOM,ALPOMP,GP(2),B0POM(2), | |
24793 | & ALREG,ALREGP,GR(2),B0REG(2), | |
24794 | & GPPP,GPPR,B0PPP,B0PPR, | |
24795 | & VDMFAC(4),VDMQ2F(4),B0HAR,AKFAC | |
24796 | C parameters of 2x2 channel model | |
24797 | DOUBLE PRECISION PHISUP,RMASS,VAR,AMPFAC,ELAFAC,VFAC | |
24798 | COMMON /PO2CHA/ PHISUP(2),RMASS(2),VAR,AMPFAC(4),ELAFAC(4),VFAC | |
24799 | C data needed for soft-pt calculation | |
24800 | DOUBLE PRECISION SIGS,DSIGHP,SIGH,FS,FH,BETAS,AAS,PTCON | |
24801 | COMMON /POINT3/ SIGS,DSIGHP,SIGH,FS,FH,BETAS(3),AAS,PTCON | |
24802 | C scale parameters for parton model calculations | |
24803 | INTEGER NQQAL,NQQALI,NQQALF,NQQPD | |
24804 | DOUBLE PRECISION AQQAL,AQQALI,AQQALF,AQQPD | |
24805 | COMMON /POHSCL/ AQQAL,AQQALI,AQQALF,AQQPD, | |
24806 | & NQQAL,NQQALI,NQQALF,NQQPD | |
24807 | C obsolete cut-off information | |
24808 | DOUBLE PRECISION PTCUT,PTANO,FPS,FPH,PSOMIN,XSOMIN | |
24809 | COMMON /POCUT1/ PTCUT(4),PTANO(4),FPS(4),FPH(4),PSOMIN,XSOMIN | |
24810 | C event weights and generated cross section | |
24811 | INTEGER IPOWGC,ISWCUT,IVWGHT | |
24812 | DOUBLE PRECISION SIGGEN,HSWGHT,HSWCUT,EVWGHT | |
24813 | COMMON /POWGHT/ SIGGEN(4),HSWGHT(0:10),HSWCUT(20),EVWGHT(0:10), | |
24814 | & IPOWGC(0:10),ISWCUT(20),IVWGHT(0:10) | |
24815 | C parameters for DGLAP backward evolution in ISR | |
24816 | INTEGER NFSISR | |
24817 | DOUBLE PRECISION Q2MISR,PMISR,ZMISR,AL2ISR | |
24818 | COMMON /PODGL1/ Q2MISR(2),PMISR(2),ZMISR(2),AL2ISR(2),NFSISR | |
24819 | C hard cross sections and MC selection weights | |
24820 | INTEGER Max_pro_2 | |
24821 | PARAMETER ( Max_pro_2 = 16 ) | |
24822 | INTEGER IHa_last,IHb_last,MH_pro_on,MH_tried, | |
24823 | & MH_acc_1,MH_acc_2 | |
24824 | DOUBLE PRECISION Hfac,HWgx,HSig,Hdpt,HEcm_last,HQ2a_last,HQ2b_last | |
24825 | COMMON /POHRCS/ Hfac(-1:Max_pro_2),HWgx(-1:Max_pro_2), | |
24826 | & HSig(-1:Max_pro_2),Hdpt(-1:Max_pro_2), | |
24827 | & HEcm_last,HQ2a_last,HQ2b_last,IHa_last,IHb_last, | |
24828 | & MH_pro_on(-1:Max_pro_2,0:4),MH_tried(-1:Max_pro_2,0:4), | |
24829 | & MH_acc_1(-1:Max_pro_2,0:4),MH_acc_2(-1:Max_pro_2,0:4) | |
24830 | C interpolation tables for hard cross section and MC selection weights | |
24831 | INTEGER Max_tab_E,Max_tab_Q2,Max_pro_tab | |
24832 | PARAMETER ( Max_tab_E = 20, Max_tab_Q2 = 10, Max_pro_tab = 16 ) | |
24833 | INTEGER IH_Q2a_up,IH_Q2b_up,IH_Ecm_up | |
24834 | DOUBLE PRECISION Hfac_tab,HWgx_tab,HSig_tab,Hdpt_tab, | |
24835 | & HQ2a_tab,HQ2b_tab,HEcm_tab | |
24836 | COMMON /POHTAB/ | |
24837 | & Hfac_tab(-1:Max_pro_tab,Max_tab_E,Max_tab_Q2,Max_tab_Q2,0:4), | |
24838 | & HWgx_tab(-1:Max_pro_tab,Max_tab_E,Max_tab_Q2,Max_tab_Q2,0:4), | |
24839 | & HSig_tab(-1:Max_pro_tab,Max_tab_E,Max_tab_Q2,Max_tab_Q2,0:4), | |
24840 | & Hdpt_tab(-1:Max_pro_tab,Max_tab_E,Max_tab_Q2,Max_tab_Q2,0:4), | |
24841 | & HQ2a_tab(1:Max_tab_Q2,0:4),HQ2b_tab(1:Max_tab_Q2,0:4), | |
24842 | & HEcm_tab(1:Max_tab_E,0:4), | |
24843 | & IH_Q2a_up(0:4),IH_Q2b_up(0:4),IH_Ecm_up(0:4) | |
24844 | C data on most recent hard scattering | |
24845 | INTEGER IA,IB,IC,ID,IV1,IV2,MSPR,IREJSC | |
24846 | DOUBLE PRECISION PTWANT,AS,AH,ALNS,ALNH,Z1MAX,Z1DIF,Z2MAX,Z2DIF, | |
24847 | & PT,PTfin,ETAC,ETAD,X1,X2,V,U,W,W1,AXX,QQPD,QQAL, | |
24848 | & PDF1,PDF2,WEIGHT,PHI1,PHI2,PHO1,PHO2 | |
24849 | COMMON /POCKIN/ PTWANT,AS,AH,ALNS,ALNH,Z1MAX,Z1DIF,Z2MAX,Z2DIF, | |
24850 | & PT,PTfin,ETAC,ETAD,X1,X2,V,U,W,W1,AXX, | |
24851 | & QQPD,QQAL,PDF1(-6:6),PDF2(-6:6),WEIGHT, | |
24852 | & PHI1(5),PHI2(5),PHO1(5),PHO2(5), | |
24853 | & IA,IB,IC,ID,IV1,IV2,MSPR,IREJSC | |
24854 | C energy-interpolation table | |
24855 | INTEGER IEETA2 | |
24856 | PARAMETER ( IEETA2 = 20 ) | |
24857 | INTEGER ISIMAX | |
24858 | DOUBLE PRECISION SIGTAB,SIGECM | |
24859 | COMMON /POTABL/ SIGTAB(4,80,IEETA2),SIGECM(4,IEETA2),ISIMAX | |
24860 | ||
24861 | DOUBLE PRECISION XP,PTS | |
24862 | DIMENSION XP(2),PTS(0:2,2) | |
24863 | ||
24864 | INTEGER IV | |
24865 | DIMENSION IV(2) | |
24866 | ||
24867 | IF(IDEB(58).GE.25) WRITE(LO,'(1X,2A,/,5X,I2,3E12.3,5I4)') | |
24868 | & 'PHO_HARINT: called with ', | |
24869 | & 'IPP,ECM,P2V1,P2V2,I1,I2,K1,K2,MSPOM', | |
24870 | & IPP,ECM,P2V1,P2V2,I1,I2,K1,K2,MSPOM | |
24871 | ||
24872 | IP = ABS(IPP) | |
24873 | IF(IPP.GT.0) THEN | |
24874 | C default minimum bias cutoff | |
24875 | PTCUT(IP) = pho_ptcut(ECM,IP) | |
24876 | ELSE | |
24877 | C user defined additional cutoff | |
24878 | PTCUT(IP) = HSWCUT(4+IP) | |
24879 | ENDIF | |
24880 | PTWANT = PTCUT(IP) | |
24881 | ||
24882 | C ISR cutoffs | |
24883 | Q2CUT = MIN(PTWANT**2,PARMDL(125+IP)) | |
24884 | Q2MISR(1) = MAX(P2V1,Q2CUT) | |
24885 | Q2MISR(2) = MAX(P2V2,Q2CUT) | |
24886 | C cutoff for direct photon contribution to photon PDF | |
24887 | PTANO(IP) = MIN(PTCUT(IP),PARMDL(129+IP)) | |
24888 | PTA1 = PTANO(IP) | |
24889 | C scales for hard scattering | |
24890 | AQQAL = PARMDL(109+IP) | |
24891 | AQQALI = PARMDL(113+IP) | |
24892 | AQQALF = PARMDL(117+IP) | |
24893 | AQQPD = PARMDL(121+IP) | |
24894 | NQQAL = IPAMDL(64+IP) | |
24895 | NQQALI = IPAMDL(68+IP) | |
24896 | NQQALF = IPAMDL(72+IP) | |
24897 | NQQPD = IPAMDL(76+IP) | |
24898 | IF(IDEB(58).GE.15) WRITE(LO,'(1X,A,4I3,4E10.3)') | |
24899 | & 'PHO_HARINT: scales:', | |
24900 | & NQQAL,NQQALI,NQQALF,NQQPD,AQQAL,AQQALI,AQQALF,AQQPD | |
24901 | ||
24902 | IF(I2.LT.-1) RETURN | |
24903 | ||
24904 | IL = IP | |
24905 | IF(IPP.LT.0) IL = 0 | |
24906 | ||
24907 | C double-log interpolation | |
24908 | IF(ECM.LT.2.1D0*PTCUT(IP)) THEN | |
24909 | DO 50 M=I1,I2 | |
24910 | Hfac(M) = 0.D0 | |
24911 | HWgx(M) = 0.D0 | |
24912 | HSig(M) = 0.D0 | |
24913 | Hdpt(M) = 0.D0 | |
24914 | 50 CONTINUE | |
24915 | ELSE | |
24916 | I=1 | |
24917 | 310 CONTINUE | |
24918 | I = I+1 | |
24919 | IF((ECM.GT.HEcm_tab(I,IL)).AND.(I.LT.IH_Ecm_up(IL))) GOTO 310 | |
24920 | ||
24921 | Ia = 1 | |
24922 | Ib = 1 | |
24923 | fac = LOG(ECM/HEcm_tab(I-1,IL)) | |
24924 | & /LOG(HEcm_tab(I,IL)/HEcm_tab(I-1,IL)) | |
24925 | do M=I1,I2 | |
24926 | C factor due to phase space integration | |
24927 | XX = LOG(Hfac_tab(M,I-1,Ia,Ib,IL)+DEPS) + fac | |
24928 | & *LOG((Hfac_tab(M,I,Ia,Ib,IL)+DEPS) | |
24929 | & /(Hfac_tab(M,I-1,Ia,Ib,IL)+DEPS)) | |
24930 | XX = EXP(XX) | |
24931 | IF(XX.LT.DEPS2) XX = 0.D0 | |
24932 | Hfac(M) = XX | |
24933 | C max. weight | |
24934 | XX = LOG(HWgx_tab(M,I-1,Ia,Ib,IL)+DEPS) + fac | |
24935 | & *LOG((HWgx_tab(M,I,Ia,Ib,IL)+DEPS) | |
24936 | & /(HWgx_tab(M,I-1,Ia,Ib,IL)+DEPS)) | |
24937 | XX = EXP(XX) | |
24938 | IF(XX.LT.DEPS2) XX = 0.D0 | |
24939 | HWgx(M) = XX*1.2D0 | |
24940 | C hard cross section | |
24941 | XX = LOG(HSig_tab(M,I-1,Ia,Ib,IL)+DEPS) + fac | |
24942 | & *LOG((HSig_tab(M,I,Ia,Ib,IL)+DEPS) | |
24943 | & /(HSig_tab(M,I-1,Ia,Ib,IL)+DEPS)) | |
24944 | XX = EXP(XX) | |
24945 | IF(XX.LT.DEPS2) XX = 0.D0 | |
24946 | HSig(M) = XX | |
24947 | C differential hard cross section | |
24948 | XX = LOG(Hdpt_tab(M,I-1,Ia,Ib,IL)+DEPS) + fac | |
24949 | & *LOG((Hdpt_tab(M,I,Ia,Ib,IL)+DEPS) | |
24950 | & /(Hdpt_tab(M,I-1,Ia,Ib,IL)+DEPS)) | |
24951 | XX = EXP(XX) | |
24952 | IF(XX.LT.DEPS2) XX = 0.D0 | |
24953 | Hdpt(M) = XX | |
24954 | enddo | |
24955 | ENDIF | |
24956 | ||
24957 | IF((K1.LT.3).AND.(K2.GE.3)) THEN | |
24958 | C cross check | |
24959 | IF((I1.GT.9).OR.(I2.LT.9)) THEN | |
24960 | WRITE(LO,'(1X,2A,2I4)') 'PHO_HARINT: ', | |
24961 | & 'hard cross section not calculated ',I1,I2 | |
24962 | ENDIF | |
24963 | SIGH = HSig(9) | |
24964 | DSIGHP = Hdpt(9) | |
24965 | C load soft cross sections from interpolation table | |
24966 | IF(ECM.LE.SIGECM(IP,1)) THEN | |
24967 | L1 = 1 | |
24968 | L2 = 1 | |
24969 | ELSE IF(ECM.LT.SIGECM(IP,ISIMAX)) THEN | |
24970 | DO 55 I=2,ISIMAX | |
24971 | IF(ECM.LE.SIGECM(IP,I)) GOTO 205 | |
24972 | 55 CONTINUE | |
24973 | 205 CONTINUE | |
24974 | L1 = I-1 | |
24975 | L2 = I | |
24976 | ELSE | |
24977 | WRITE(LO,'(/1X,A,I3,1P,2E11.3)') | |
24978 | & 'PHO_HARINT: energy too high (IP,Ecm,Emax)', | |
24979 | & IP,ECM,SIGECM(IP,ISIMAX) | |
24980 | CALL PHO_PREVNT(-1) | |
24981 | L1 = ISIMAX-1 | |
24982 | L2 = ISIMAX | |
24983 | ENDIF | |
24984 | FAC2=0.D0 | |
24985 | IF(L1.NE.L2) FAC2=LOG(ECM/SIGECM(IP,L1)) | |
24986 | & /LOG(SIGECM(IP,L2)/SIGECM(IP,L1)) | |
24987 | FAC1=1.D0-FAC2 | |
24988 | SIGS = FAC2*(SIGTAB(IP,56,L2)+SIGTAB(IP,57,L2))+ | |
24989 | & FAC1*(SIGTAB(IP,56,L1)+SIGTAB(IP,57,L1)) | |
24990 | ||
24991 | FS = FPS(IP) | |
24992 | FH = FPH(IP) | |
24993 | CALL PHO_SOFTPT(-1,PTWANT,PTWANT,XP,IV,PTS) | |
24994 | ENDIF | |
24995 | ||
24996 | 300 CONTINUE | |
24997 | ||
24998 | C debug output | |
24999 | IF(IDEB(58).GE.15) THEN | |
25000 | WRITE(LO,'(1X,A,I10,3I2,2E10.3)') | |
25001 | & 'PHO_HARINT: weights EV,IP,K1/2,ECM,PTC', | |
25002 | & KEVENT,IP,K1,K2,ECM,PTCUT(IP) | |
25003 | DO 162 M=I1,I2 | |
25004 | WRITE(LO,'(5X,2I3,1p,4E12.3)') | |
25005 | & M,MH_pro_on(M,IP),Hfac(M),HWgx(M),HSig(M),Hdpt(M) | |
25006 | 162 CONTINUE | |
25007 | ENDIF | |
25008 | ||
25009 | END | |
25010 | ||
25011 | *$ CREATE PHO_PTCUT.FOR | |
25012 | *COPY PHO_PTCUT | |
25013 | DOUBLE PRECISION FUNCTION PHO_PTCUT(ECM,IP) | |
25014 | C*********************************************************************** | |
25015 | C | |
25016 | C calculate energy-dependent transverse momentum cutoff | |
25017 | C | |
25018 | C*********************************************************************** | |
25019 | IMPLICIT NONE | |
25020 | SAVE | |
25021 | ||
25022 | double precision ECM | |
25023 | integer IP | |
25024 | ||
25025 | C input/output channels | |
25026 | INTEGER LI,LO | |
25027 | COMMON /POINOU/ LI,LO | |
25028 | C event debugging information | |
25029 | INTEGER NMAXD | |
25030 | PARAMETER (NMAXD=100) | |
25031 | INTEGER IDEB,KSPOM,KHPOM,KSREG,KHDIR,KACCEP,KSTRG,KHTRG,KSLOO, | |
25032 | & KHLOO,KSDPO,KHDPO,KEVENT,KSOFT,KHARD | |
25033 | COMMON /PODEBG/ IDEB(NMAXD),KSPOM,KHPOM,KSREG,KHDIR,KACCEP,KSTRG, | |
25034 | & KHTRG,KSLOO,KHLOO,KSDPO,KHDPO,KEVENT,KSOFT,KHARD | |
25035 | C model switches and parameters | |
25036 | CHARACTER*8 MDLNA | |
25037 | INTEGER ISWMDL,IPAMDL | |
25038 | DOUBLE PRECISION PARMDL | |
25039 | COMMON /POMDLS/ MDLNA(50),ISWMDL(50),PARMDL(400),IPAMDL(400) | |
25040 | ||
25041 | pho_ptcut = PARMDL(35+IP) | |
25042 | ||
25043 | IF(IPAMDL(7).EQ.1) THEN | |
25044 | C Bopp et al. type (DPMJET) | |
25045 | pho_ptcut = PARMDL(35+IP) | |
25046 | & + max(0.D0,0.12D0*(LOG10(ECM/50.D0))**3) | |
25047 | ELSE IF(IPAMDL(7).EQ.2) THEN | |
25048 | C Gribov-Levin-Ryskin type | |
25049 | pho_ptcut = PARMDL(35+IP) | |
25050 | & + 0.065D0*exp(0.9D0*sqrt(2.D0*log(Ecm))) | |
25051 | ENDIF | |
25052 | ||
25053 | END | |
25054 | ||
25055 | *$ CREATE PHO_HARMCI.FOR | |
25056 | *COPY PHO_HARMCI | |
25057 | CDECK ID>, PHO_HARMCI | |
25058 | SUBROUTINE PHO_HARMCI(IP,EMAXF) | |
25059 | C********************************************************************** | |
25060 | C | |
25061 | C initialize MC sampling and calculate hard cross section | |
25062 | C | |
25063 | C input: IP particle combination (neg. number for user cut) | |
25064 | C EMAXF maximum CMS energy for | |
25065 | C interpolation table in reference to PTCUT(1..4) | |
25066 | C | |
25067 | C*********************************************************************** | |
25068 | IMPLICIT DOUBLE PRECISION (A-H,O-Z) | |
25069 | SAVE | |
25070 | ||
25071 | PARAMETER (DEPS = 1.D-10, | |
25072 | & PLARGE = 1.D20 ) | |
25073 | ||
25074 | C input/output channels | |
25075 | INTEGER LI,LO | |
25076 | COMMON /POINOU/ LI,LO | |
25077 | C event debugging information | |
25078 | INTEGER NMAXD | |
25079 | PARAMETER (NMAXD=100) | |
25080 | INTEGER IDEB,KSPOM,KHPOM,KSREG,KHDIR,KACCEP,KSTRG,KHTRG,KSLOO, | |
25081 | & KHLOO,KSDPO,KHDPO,KEVENT,KSOFT,KHARD | |
25082 | COMMON /PODEBG/ IDEB(NMAXD),KSPOM,KHPOM,KSREG,KHDIR,KACCEP,KSTRG, | |
25083 | & KHTRG,KSLOO,KHLOO,KSDPO,KHDPO,KEVENT,KSOFT,KHARD | |
25084 | C some constants | |
25085 | DOUBLE PRECISION PI,PI2,PI4,GEV2MB,Q_ch,Q_ch2,Q_ch4 | |
25086 | COMMON /POCONS/ PI,PI2,PI4,GEV2MB, | |
25087 | & Q_ch(-6:6),Q_ch2(-6:6),Q_ch4(-6:6) | |
25088 | C global event kinematics and particle IDs | |
25089 | INTEGER IFPAP,IFPAB | |
25090 | DOUBLE PRECISION ECM,PCM,PMASS,PVIRT | |
25091 | COMMON /POGCMS/ ECM,PCM,PMASS(2),PVIRT(2),IFPAP(2),IFPAB(2) | |
25092 | C data of c.m. system of Pomeron / Reggeon exchange | |
25093 | INTEGER NPOSP,IDPDG1,IDBAM1,IDPDG2,IDBAM2 | |
25094 | DOUBLE PRECISION ECMP,PCMP,PMASSP,PVIRTP,GAMBEP, | |
25095 | & SIDP,CODP,SIFP,COFP | |
25096 | COMMON /POPCMS/ ECMP,PCMP,PMASSP(2),PVIRTP(2),GAMBEP(4), | |
25097 | & SIDP,CODP,SIFP,COFP,NPOSP(2), | |
25098 | & IDPDG1,IDBAM1,IDPDG2,IDBAM2 | |
25099 | C model switches and parameters | |
25100 | CHARACTER*8 MDLNA | |
25101 | INTEGER ISWMDL,IPAMDL | |
25102 | DOUBLE PRECISION PARMDL | |
25103 | COMMON /POMDLS/ MDLNA(50),ISWMDL(50),PARMDL(400),IPAMDL(400) | |
25104 | C obsolete cut-off information | |
25105 | DOUBLE PRECISION PTCUT,PTANO,FPS,FPH,PSOMIN,XSOMIN | |
25106 | COMMON /POCUT1/ PTCUT(4),PTANO(4),FPS(4),FPH(4),PSOMIN,XSOMIN | |
25107 | C scale parameters for parton model calculations | |
25108 | INTEGER NQQAL,NQQALI,NQQALF,NQQPD | |
25109 | DOUBLE PRECISION AQQAL,AQQALI,AQQALF,AQQPD | |
25110 | COMMON /POHSCL/ AQQAL,AQQALI,AQQALF,AQQPD, | |
25111 | & NQQAL,NQQALI,NQQALF,NQQPD | |
25112 | C names of hard scattering processes | |
25113 | INTEGER Max_pro_1 | |
25114 | PARAMETER ( Max_pro_1 = 16 ) | |
25115 | CHARACTER*18 PROC | |
25116 | COMMON /POHPRO/ PROC(0:Max_pro_1) | |
25117 | C hard cross sections and MC selection weights | |
25118 | INTEGER Max_pro_2 | |
25119 | PARAMETER ( Max_pro_2 = 16 ) | |
25120 | INTEGER IHa_last,IHb_last,MH_pro_on,MH_tried, | |
25121 | & MH_acc_1,MH_acc_2 | |
25122 | DOUBLE PRECISION Hfac,HWgx,HSig,Hdpt,HEcm_last,HQ2a_last,HQ2b_last | |
25123 | COMMON /POHRCS/ Hfac(-1:Max_pro_2),HWgx(-1:Max_pro_2), | |
25124 | & HSig(-1:Max_pro_2),Hdpt(-1:Max_pro_2), | |
25125 | & HEcm_last,HQ2a_last,HQ2b_last,IHa_last,IHb_last, | |
25126 | & MH_pro_on(-1:Max_pro_2,0:4),MH_tried(-1:Max_pro_2,0:4), | |
25127 | & MH_acc_1(-1:Max_pro_2,0:4),MH_acc_2(-1:Max_pro_2,0:4) | |
25128 | C interpolation tables for hard cross section and MC selection weights | |
25129 | INTEGER Max_tab_E,Max_tab_Q2,Max_pro_tab | |
25130 | PARAMETER ( Max_tab_E = 20, Max_tab_Q2 = 10, Max_pro_tab = 16 ) | |
25131 | INTEGER IH_Q2a_up,IH_Q2b_up,IH_Ecm_up | |
25132 | DOUBLE PRECISION Hfac_tab,HWgx_tab,HSig_tab,Hdpt_tab, | |
25133 | & HQ2a_tab,HQ2b_tab,HEcm_tab | |
25134 | COMMON /POHTAB/ | |
25135 | & Hfac_tab(-1:Max_pro_tab,Max_tab_E,Max_tab_Q2,Max_tab_Q2,0:4), | |
25136 | & HWgx_tab(-1:Max_pro_tab,Max_tab_E,Max_tab_Q2,Max_tab_Q2,0:4), | |
25137 | & HSig_tab(-1:Max_pro_tab,Max_tab_E,Max_tab_Q2,Max_tab_Q2,0:4), | |
25138 | & Hdpt_tab(-1:Max_pro_tab,Max_tab_E,Max_tab_Q2,Max_tab_Q2,0:4), | |
25139 | & HQ2a_tab(1:Max_tab_Q2,0:4),HQ2b_tab(1:Max_tab_Q2,0:4), | |
25140 | & HEcm_tab(1:Max_tab_E,0:4), | |
25141 | & IH_Q2a_up(0:4),IH_Q2b_up(0:4),IH_Ecm_up(0:4) | |
25142 | C event weights and generated cross section | |
25143 | INTEGER IPOWGC,ISWCUT,IVWGHT | |
25144 | DOUBLE PRECISION SIGGEN,HSWGHT,HSWCUT,EVWGHT | |
25145 | COMMON /POWGHT/ SIGGEN(4),HSWGHT(0:10),HSWCUT(20),EVWGHT(0:10), | |
25146 | & IPOWGC(0:10),ISWCUT(20),IVWGHT(0:10) | |
25147 | ||
25148 | COMPLEX*16 DSIG | |
25149 | DIMENSION DSIG(0:Max_pro_2),DSPT(0:Max_pro_2) | |
25150 | ||
25151 | C initialization for all pt cutoffs | |
25152 | I = ABS(IP) | |
25153 | IL = I | |
25154 | IF(IP.LT.0) THEN | |
25155 | IL = 0 | |
25156 | PTC = HSWCUT(4+I) | |
25157 | else | |
25158 | PTC = pho_ptcut(parmdl(19),I) | |
25159 | ENDIF | |
25160 | ||
25161 | C skip unassigned PTCUT | |
25162 | IF(PTC.LT.0.5D0) GOTO 1000 | |
25163 | ||
25164 | IH_Q2a_up(I) = 1 | |
25165 | IH_Q2b_up(I) = 1 | |
25166 | do ib=1,Max_tab_Q2 | |
25167 | do ia=1,Max_tab_Q2 | |
25168 | do ie=1,Max_tab_E | |
25169 | do m=-1,Max_pro_2 | |
25170 | Hfac_tab(M,Ie,Ia,Ib,I) = 0.D0 | |
25171 | HWgx_tab(M,Ie,Ia,Ib,I) = 0.D0 | |
25172 | HSig_tab(M,Ie,Ia,Ib,I) = 0.D0 | |
25173 | Hdpt_tab(M,Ie,Ia,Ib,I) = 0.D0 | |
25174 | enddo | |
25175 | enddo | |
25176 | enddo | |
25177 | enddo | |
25178 | ||
25179 | ELLOW = LOG(2.05*PTC) | |
25180 | DELTA = (LOG(EMAXF)-ELLOW)/DBLE(IH_Ecm_up(I)-1) | |
25181 | C energy too low | |
25182 | IF(DELTA.LE.0.D0) GOTO 1000 | |
25183 | ||
25184 | C switch between external particles and Pomeron | |
25185 | IF(I.EQ.4) THEN | |
25186 | IDP1 = 990 | |
25187 | PV1 = 0.D0 | |
25188 | IDP2 = 990 | |
25189 | PV2 = 0.D0 | |
25190 | ELSE IF(I.EQ.3) THEN | |
25191 | IDP1 = IFPAP(2) | |
25192 | PV1 = PVIRT(2) | |
25193 | IDP2 = 990 | |
25194 | PV2 = 0.D0 | |
25195 | ELSE IF(I.EQ.2) THEN | |
25196 | IDP1 = IFPAP(1) | |
25197 | PV1 = PVIRT(1) | |
25198 | IDP2 = 990 | |
25199 | PV2 = 0.D0 | |
25200 | ELSE | |
25201 | IDP1 = IFPAP(1) | |
25202 | PV1 = PVIRT(1) | |
25203 | IDP2 = IFPAP(2) | |
25204 | PV2 = PVIRT(2) | |
25205 | ENDIF | |
25206 | ||
25207 | C initialize PT scales | |
25208 | IF((IDPDG1.EQ.22).OR.(IDPDG1.EQ.990)) THEN | |
25209 | IF((IDPDG2.EQ.22).OR.(IDPDG2.EQ.990)) THEN | |
25210 | FPS(I) = PARMDL(105) | |
25211 | FPH(I) = PARMDL(106) | |
25212 | ELSE | |
25213 | FPS(I) = PARMDL(103) | |
25214 | FPH(I) = PARMDL(104) | |
25215 | ENDIF | |
25216 | ELSE IF((IDPDG2.EQ.22).OR.(IDPDG2.EQ.990)) THEN | |
25217 | FPS(I) = PARMDL(103) | |
25218 | FPH(I) = PARMDL(104) | |
25219 | ELSE | |
25220 | FPS(I) = PARMDL(101) | |
25221 | FPH(I) = PARMDL(102) | |
25222 | ENDIF | |
25223 | ||
25224 | C initialize hard scattering | |
25225 | IF(IP.GT.0) THEN | |
25226 | CALL PHO_HARINI(I,IDP1,IDP2,PV1,PV2,6,IDEB(8)+1) | |
25227 | ELSE | |
25228 | CALL PHO_HARINI(I,IDP1,IDP2,PV1,PV2,6,IDEB(8)) | |
25229 | ENDIF | |
25230 | ||
25231 | C energy/virtuality grid | |
25232 | do Ie=1,IH_Ecm_up(IL) | |
25233 | HEcm_tab(Ie,IL) = EXP(ELLOW+DELTA*(IE-1)) | |
25234 | enddo | |
25235 | do Ia=1,IH_Q2a_up(IL) | |
25236 | HQ2a_tab(Ia,IL) = 0.D0 | |
25237 | enddo | |
25238 | do Ib=1,IH_Q2b_up(IL) | |
25239 | HQ2b_tab(Ib,IL) = 0.D0 | |
25240 | enddo | |
25241 | ||
25242 | C initialization for several energies and particle virtualities | |
25243 | do Ie=1,IH_Ecm_up(IL) | |
25244 | do Ia=1,IH_Q2a_up(IL) | |
25245 | do Ib=1,IH_Q2b_up(IL) | |
25246 | ||
25247 | EE = HEcm_tab(IE,IL) | |
25248 | Q2a = HQ2a_tab(Ia,IL) | |
25249 | Q2b = HQ2b_tab(Ib,IL) | |
25250 | CALL PHO_HARINT(IP,EE,0.D0,0.D0,0,-2,0,0,1) | |
25251 | IF(IDEB(8).GE.5) WRITE(LO,'(1X,A,2E10.3,2I7)') | |
25252 | & 'PHO_HARMCI: initialization PT,ECM,ID1,ID2:', | |
25253 | & PTCUT(I),EE,IDPDG1,IDPDG2 | |
25254 | Hfac_tab(0,Ie,Ia,Ib,IL) = PTCUT(I) | |
25255 | CALL PHO_HARFAC(PTCUT(I),EE) | |
25256 | CALL PHO_HARWGX(PTCUT(I),EE) | |
25257 | CALL PHO_HARXTO(EE,PTCUT(I),PTCUT(I),DSIG,DSPT) | |
25258 | IF(IDEB(8).GE.10) THEN | |
25259 | WRITE(LO,'(1X,A,/,1X,A)') | |
25260 | & 'hard cross sections SIGH(mb),DSIG/DPT(mb/GeV**2)', | |
25261 | & '------------------------------------------------' | |
25262 | DO M=0,Max_pro_2 | |
25263 | WRITE(LO,'(10X,A,1P2E14.4)') | |
25264 | & PROC(M),DREAL(DSIG(M)),DSPT(M) | |
25265 | ENDDO | |
25266 | ENDIF | |
25267 | ||
25268 | C store in interpolation tables | |
25269 | Hfac_tab(-1,IE,Ia,Ib,IL) = Hfac(-1) | |
25270 | HWgx_tab(-1,IE,Ia,Ib,IL) = HWgx(-1) | |
25271 | do M=0,Max_pro_2 | |
25272 | Hfac_tab(M,IE,Ia,Ib,IL) = Hfac(M) | |
25273 | HWgx_tab(M,IE,Ia,Ib,IL) = HWgx(M) | |
25274 | HSig_tab(M,IE,Ia,Ib,IL) = DREAL(DSIG(M))*MH_pro_on(M,I) | |
25275 | Hdpt_tab(M,IE,Ia,Ib,IL) = DSPT(M)*MH_pro_on(M,I) | |
25276 | enddo | |
25277 | ||
25278 | C summed quantities | |
25279 | HSig_tab(9,IE,Ia,Ib,IL) = 0.D0 | |
25280 | Hdpt_tab(9,IE,Ia,Ib,IL) = 0.D0 | |
25281 | do M=1,8 | |
25282 | IF(MH_pro_on(M,I).GT.0) THEN | |
25283 | HSig_tab(9,IE,Ia,Ib,IL) = | |
25284 | & HSig_tab(9,IE,Ia,Ib,IL) + HSig_tab(M,IE,Ia,Ib,IL) | |
25285 | Hdpt_tab(9,IE,Ia,Ib,IL) = | |
25286 | & Hdpt_tab(9,IE,Ia,Ib,IL) + Hdpt_tab(M,IE,Ia,Ib,IL) | |
25287 | ENDIF | |
25288 | enddo | |
25289 | HSig_tab(15,IE,Ia,Ib,IL) = 0.D0 | |
25290 | Hdpt_tab(15,IE,Ia,Ib,IL) = 0.D0 | |
25291 | do M=10,14 | |
25292 | IF(MH_pro_on(M,I).GT.0) THEN | |
25293 | HSig_tab(15,IE,Ia,Ib,IL) = | |
25294 | & HSig_tab(15,IE,Ia,Ib,IL) + HSig_tab(M,IE,Ia,Ib,IL) | |
25295 | Hdpt_tab(15,IE,Ia,Ib,IL) = | |
25296 | & Hdpt_tab(15,IE,Ia,Ib,IL) + Hdpt_tab(M,IE,Ia,Ib,IL) | |
25297 | ENDIF | |
25298 | enddo | |
25299 | HSig_tab(0,IE,Ia,Ib,IL) = | |
25300 | & HSig_tab(9,IE,Ia,Ib,IL) + HSig_tab(15,IE,Ia,Ib,IL) | |
25301 | Hdpt_tab(0,IE,Ia,Ib,IL) = | |
25302 | & Hdpt_tab(9,IE,Ia,Ib,IL) + Hdpt_tab(15,IE,Ia,Ib,IL) | |
25303 | ||
25304 | enddo | |
25305 | enddo | |
25306 | enddo | |
25307 | ||
25308 | C debug output of weights | |
25309 | 1000 CONTINUE | |
25310 | IF(IDEB(8).GE.5) THEN | |
25311 | WRITE(LO,'(/1X,A,5X,2I7,I3,F7.2,/1X,A)') | |
25312 | & 'PHO_HARMCI: weights, maxima (ID1/2,IP,PTC)', | |
25313 | & IDPDG1,IDPDG2,IP,PTCUT(I), | |
25314 | & '------------------------------------------' | |
25315 | DO M=-1,Max_pro_2 | |
25316 | IF((M.EQ.0).OR.(M.EQ.9).OR.(M.EQ.15)) GOTO 512 | |
25317 | WRITE(LO,'(2X,A,I3,2I7)') | |
25318 | & 'PHO_HARMCI: ECM Hfac, HWgx, HSig, Hdpt for MSTR,ID1,ID2', | |
25319 | & M,IDPDG1,IDPDG2 | |
25320 | do k=1,IH_Ecm_up(IL) | |
25321 | do ia=1,IH_Q2a_up(IL) | |
25322 | do ib=1,IH_Q2b_up(IL) | |
25323 | WRITE(LO,'(3X,1p,7E10.3)') HEcm_tab(k,IL), | |
25324 | & HQ2a_tab(ia,IL),HQ2b_tab(ib,IL), | |
25325 | & Hfac_tab(M,k,ia,ib,IL),HWgx_tab(M,k,ia,ib,IL), | |
25326 | & HSig_tab(M,k,ia,ib,IL),Hdpt_tab(M,k,ia,ib,IL) | |
25327 | enddo | |
25328 | enddo | |
25329 | enddo | |
25330 | 512 CONTINUE | |
25331 | ENDDO | |
25332 | ENDIF | |
25333 | ||
25334 | END | |
25335 | ||
25336 | *$ CREATE PHO_HARXR3.FOR | |
25337 | *COPY PHO_HARXR3 | |
25338 | CDECK ID>, PHO_HARXR3 | |
25339 | SUBROUTINE PHO_HARXR3(ECMH,PT,ETAC,ETAD,DSIGMC) | |
25340 | C********************************************************************** | |
25341 | C | |
25342 | C differential cross section DSIG/(DETAC*DETAD*DPT) | |
25343 | C | |
25344 | C input: ECMH CMS energy | |
25345 | C PT parton PT | |
25346 | C ETAC pseudorapidity of parton C | |
25347 | C ETAD pseudorapidity of parton D | |
25348 | C | |
25349 | C output: DSIGMC(0:15) QCD-PM cross sections dsigma/dpt/detac/detad | |
25350 | C | |
25351 | C********************************************************************** | |
25352 | IMPLICIT DOUBLE PRECISION (A-H,O-Z) | |
25353 | SAVE | |
25354 | ||
25355 | PARAMETER ( TINY= 1.D-30, ONEP1=1.1, TINY6=1.D-06, EPS=1.D-20) | |
25356 | ||
25357 | PARAMETER ( Max_pro_2 = 16 ) | |
25358 | COMPLEX*16 DSIGMC | |
25359 | DIMENSION DSIGMC(0:Max_pro_2) | |
25360 | DIMENSION DSIGM(0:Max_pro_2) | |
25361 | ||
25362 | C input/output channels | |
25363 | INTEGER LI,LO | |
25364 | COMMON /POINOU/ LI,LO | |
25365 | C some constants | |
25366 | DOUBLE PRECISION PI,PI2,PI4,GEV2MB,Q_ch,Q_ch2,Q_ch4 | |
25367 | COMMON /POCONS/ PI,PI2,PI4,GEV2MB, | |
25368 | & Q_ch(-6:6),Q_ch2(-6:6),Q_ch4(-6:6) | |
25369 | C Reggeon phenomenology parameters | |
25370 | DOUBLE PRECISION ALPOM,ALPOMP,GP,B0POM,ALREG,ALREGP,GR,B0REG, | |
25371 | & GPPP,GPPR,B0PPP,B0PPR,VDMFAC,VDMQ2F,B0HAR,AKFAC | |
25372 | COMMON /POPREG/ ALPOM,ALPOMP,GP(2),B0POM(2), | |
25373 | & ALREG,ALREGP,GR(2),B0REG(2), | |
25374 | & GPPP,GPPR,B0PPP,B0PPR, | |
25375 | & VDMFAC(4),VDMQ2F(4),B0HAR,AKFAC | |
25376 | C currently activated parton density parametrizations | |
25377 | CHARACTER*8 PDFNAM | |
25378 | INTEGER IPARID,IPAVA,ITYPE,IGRP,ISET,IEXT,NPAOLD | |
25379 | DOUBLE PRECISION PDFLAM,PDFQ2M | |
25380 | COMMON /POPPDF/ PDFLAM(2),PDFQ2M(2),PDFNAM(2),IPARID(2), | |
25381 | & IPAVA(2),ITYPE(2),IGRP(2),ISET(2),IEXT(2),NPAOLD | |
25382 | C hard scattering parameters used for most recent hard interaction | |
25383 | INTEGER NFbeta,NF | |
25384 | DOUBLE PRECISION ALQCD2,BQCD | |
25385 | COMMON /POHAPA/ ALQCD2(3,4),BQCD(4),NFbeta,NF | |
25386 | C scale parameters for parton model calculations | |
25387 | INTEGER NQQAL,NQQALI,NQQALF,NQQPD | |
25388 | DOUBLE PRECISION AQQAL,AQQALI,AQQALF,AQQPD | |
25389 | COMMON /POHSCL/ AQQAL,AQQALI,AQQALF,AQQPD, | |
25390 | & NQQAL,NQQALI,NQQALF,NQQPD | |
25391 | ||
25392 | DOUBLE PRECISION PHO_ALPHAS | |
25393 | DIMENSION PDA(-6:6),PDB(-6:6) | |
25394 | ||
25395 | DO 10 I=1,9 | |
25396 | DSIGMC(I) = CMPLX(0.D0,0.D0) | |
25397 | DSIGM(I) = 0.D0 | |
25398 | 10 CONTINUE | |
25399 | ||
25400 | EC = EXP(ETAC) | |
25401 | ED = EXP(ETAD) | |
25402 | C kinematic conversions | |
25403 | XA = PT*(EC+ED)/ECMH | |
25404 | XB = XA/(EC*ED) | |
25405 | IF((XA.GE.1.D0).OR.(XB.GE.1.D0)) THEN | |
25406 | WRITE(LO,'(/1X,A,2E12.4)') 'PHO_HARXR3:ERROR:X1 OR X2 > 1',XA,XB | |
25407 | RETURN | |
25408 | ENDIF | |
25409 | SP = XA*XB*ECMH*ECMH | |
25410 | UP =-ECMH*PT*EC*XB | |
25411 | UP = UP/SP | |
25412 | TP =-(1.D0+UP) | |
25413 | UU = UP*UP | |
25414 | TT = TP*TP | |
25415 | C set hard scale QQ for alpha and partondistr. | |
25416 | IF ( NQQAL.EQ.1 ) THEN | |
25417 | QQAL = AQQAL*PT*PT | |
25418 | ELSEIF ( NQQAL.EQ.2 ) THEN | |
25419 | QQAL = AQQAL*SP*UP*TP/(1.D0+TT+UU) | |
25420 | ELSEIF ( NQQAL.EQ.3 ) THEN | |
25421 | QQAL = AQQAL*SP | |
25422 | ELSEIF ( NQQAL.EQ.4 ) THEN | |
25423 | QQAL = AQQAL*SP*(UP*TP)**(1.D0/3.D0) | |
25424 | ENDIF | |
25425 | IF ( NQQPD.EQ.1 ) THEN | |
25426 | QQPD = AQQPD*PT*PT | |
25427 | ELSEIF ( NQQPD.EQ.2 ) THEN | |
25428 | QQPD = AQQPD*SP*UP*TP/(1.D0+TT+UU) | |
25429 | ELSEIF ( NQQPD.EQ.3 ) THEN | |
25430 | QQPD = AQQPD*SP | |
25431 | ELSEIF ( NQQPD.EQ.4 ) THEN | |
25432 | QQPD = AQQPD*SP*(UP*TP)**(1.D0/3.D0) | |
25433 | ENDIF | |
25434 | ||
25435 | ALPHA = PHO_ALPHAS(QQAL,3) | |
25436 | FACTOR = PI2*GEV2MB*PT*(ALPHA/SP)**2*AKFAC | |
25437 | C parton distributions (times x) | |
25438 | CALL PHO_PDF(1,XA,QQPD,0.D0,PDA) | |
25439 | CALL PHO_PDF(2,XB,QQPD,0.D0,PDB) | |
25440 | S1 = PDA(0)*PDB(0) | |
25441 | S2 = 0.D0 | |
25442 | S3 = 0.D0 | |
25443 | S4 = 0.D0 | |
25444 | S5 = 0.D0 | |
25445 | DO 20 I=1,NF | |
25446 | S2 = S2+PDA(I)*PDB(-I)+PDA(-I)*PDB( I) | |
25447 | S3 = S3+PDA(I)*PDB( I)+PDA(-I)*PDB(-I) | |
25448 | S4 = S4+PDA(I)+PDA(-I) | |
25449 | S5 = S5+PDB(I)+PDB(-I) | |
25450 | 20 CONTINUE | |
25451 | C partial cross sections (including color and symmetry factors) | |
25452 | C resolved photon matrix elements (light quarks) | |
25453 | DSIGM(1) = 2.25D0*(3.-((UP*TP)+UP/TT+TP/UU)) | |
25454 | DSIGM(6) = (4.D0/9.D0)*(UU+TT) | |
25455 | DSIGM(8) = (4.D0/9.D0)*(1.D0+UU)/TT | |
25456 | DSIGM(2) = (16.D0/27.D0)*(UU+TT)/(UP*TP)-3.D0*DSIGM(6) | |
25457 | DSIGM(3) = ((1.D0+UU)/TT)-(4.D0/9.D0)*(1.D0+UU)/UP | |
25458 | DSIGM(4) = (9.D0/32.D0)*DSIGM(2) | |
25459 | DSIGM(5) = DSIGM(6)+DSIGM(8)-(8.D0/27.D0)*UU/TP | |
25460 | DSIGM(7) = 0.5D0*(DSIGM(8)+(4.D0/9.D0)*(1.D0+TT)/UU- | |
25461 | & (8.D0/27.D0)/(UP*TP)) | |
25462 | C | |
25463 | DSIGM(1) = FACTOR*DSIGM(1)*S1 | |
25464 | DSIGM(2) = FACTOR*DSIGM(2)*S2 | |
25465 | DSIGM(3) = FACTOR*DSIGM(3)*(PDA(0)*S5+PDB(0)*S4) | |
25466 | DSIGM(4) = FACTOR*DSIGM(4)*S1*NF | |
25467 | DSIGM(5) = FACTOR*DSIGM(5)*S2 | |
25468 | DSIGM(6) = FACTOR*DSIGM(6)*S2*MAX(0,(NF-1)) | |
25469 | DSIGM(7) = FACTOR*DSIGM(7)*S3 | |
25470 | DSIGM(8) = FACTOR*DSIGM(8)*(S4*S5-(S2+S3)) | |
25471 | C complex part | |
25472 | X=ABS(TP-UP) | |
25473 | FAC2 = -LOG((X+2.D0)/(X+1.D-30))/PI | |
25474 | C | |
25475 | DO 50 I=1,8 | |
25476 | IF(DSIGM(I).LT.EPS) DSIGM(I) = 0.D0 | |
25477 | DSIGMC(I) = CMPLX(DSIGM(I),DSIGM(I)*FAC2) | |
25478 | DSIGMC(9) = DSIGMC(9)+DSIGMC(I) | |
25479 | 50 CONTINUE | |
25480 | END | |
25481 | ||
25482 | *$ CREATE PHO_HARXR2.FOR | |
25483 | *COPY PHO_HARXR2 | |
25484 | CDECK ID>, PHO_HARXR2 | |
25485 | SUBROUTINE PHO_HARXR2(ECMH,PT,ETAC,DSIGMC) | |
25486 | C********************************************************************** | |
25487 | C | |
25488 | C differential cross section DSIG/(DETAC*DPT) | |
25489 | C | |
25490 | C input: ECMH CMS energy | |
25491 | C PT parton PT | |
25492 | C ETAC pseudorapidity of parton C | |
25493 | C | |
25494 | C output: DSIGMC(0:15) QCD-PM cross sections dsigma/dpt/detac | |
25495 | C | |
25496 | C********************************************************************** | |
25497 | IMPLICIT DOUBLE PRECISION (A-H,O-Z) | |
25498 | SAVE | |
25499 | ||
25500 | PARAMETER ( TINY= 1.D-20 ) | |
25501 | ||
25502 | PARAMETER ( Max_pro_2 = 16 ) | |
25503 | COMPLEX*16 DSIGMC | |
25504 | DIMENSION DSIGMC(0:Max_pro_2) | |
25505 | ||
25506 | C input/output channels | |
25507 | INTEGER LI,LO | |
25508 | COMMON /POINOU/ LI,LO | |
25509 | C integration precision for hard cross sections (obsolete) | |
25510 | INTEGER NGAUP1,NGAUP2,NGAUET,NGAUIN,NGAUSO | |
25511 | COMMON /POGAUP/ NGAUP1,NGAUP2,NGAUET,NGAUIN,NGAUSO | |
25512 | ||
25513 | COMPLEX*16 DSIG1 | |
25514 | DIMENSION DSIG1(0:Max_pro_2) | |
25515 | DIMENSION ABSZ(32),WEIG(32) | |
25516 | ||
25517 | DO 10 M=1,9 | |
25518 | DSIGMC(M) = CMPLX(0.D0,0.D0) | |
25519 | DSIG1(M) = 0.D0 | |
25520 | 10 CONTINUE | |
25521 | C | |
25522 | EC = EXP(ETAC) | |
25523 | ARG = ECMH/PT | |
25524 | IF ( ARG.LE.EC .OR. ARG.LE.1.D0/EC ) RETURN | |
25525 | EDU = LOG(ARG-EC) | |
25526 | EDL =-LOG(ARG-1.D0/EC) | |
25527 | NPOINT = NGAUET | |
25528 | CALL PHO_GAUSET(EDL,EDU,NPOINT,ABSZ,WEIG) | |
25529 | DO 30 I=1,NPOINT | |
25530 | CALL PHO_HARXR3(ECMH,PT,ETAC,ABSZ(I),DSIG1) | |
25531 | DO 20 M=1,9 | |
25532 | PCTRL= DREAL(DSIG1(M))/TINY | |
25533 | IF( PCTRL.GE.1.D0 ) THEN | |
25534 | DSIGMC(M) = DSIGMC(M)+WEIG(I)*DSIG1(M) | |
25535 | ENDIF | |
25536 | 20 CONTINUE | |
25537 | 30 CONTINUE | |
25538 | END | |
25539 | ||
25540 | *$ CREATE PHO_HARXD2.FOR | |
25541 | *COPY PHO_HARXD2 | |
25542 | CDECK ID>, PHO_HARXD2 | |
25543 | SUBROUTINE PHO_HARXD2(ECMH,PT,ETAC,DSIGMC) | |
25544 | C********************************************************************** | |
25545 | C | |
25546 | C differential cross section DSIG/(DETAC*DPT) for direct processes | |
25547 | C | |
25548 | C input: ECMH CMS energy of scattering system | |
25549 | C PT parton PT | |
25550 | C ETAC pseudorapidity of parton C | |
25551 | C | |
25552 | C output: DSIGMC(0:15) QCD-PM cross sections dsigma/dpt/detac | |
25553 | C | |
25554 | C********************************************************************** | |
25555 | IMPLICIT DOUBLE PRECISION (A-H,O-Z) | |
25556 | SAVE | |
25557 | ||
25558 | PARAMETER ( Max_pro_2 = 16 ) | |
25559 | COMPLEX*16 DSIGMC | |
25560 | DIMENSION DSIGMC(0:Max_pro_2) | |
25561 | PARAMETER ( TINY= 1.D-30, ONEP1=1.1, TINY6=1.D-06, EPS=1.D-25) | |
25562 | ||
25563 | C input/output channels | |
25564 | INTEGER LI,LO | |
25565 | COMMON /POINOU/ LI,LO | |
25566 | C model switches and parameters | |
25567 | CHARACTER*8 MDLNA | |
25568 | INTEGER ISWMDL,IPAMDL | |
25569 | DOUBLE PRECISION PARMDL | |
25570 | COMMON /POMDLS/ MDLNA(50),ISWMDL(50),PARMDL(400),IPAMDL(400) | |
25571 | C data of c.m. system of Pomeron / Reggeon exchange | |
25572 | INTEGER NPOSP,IDPDG1,IDBAM1,IDPDG2,IDBAM2 | |
25573 | DOUBLE PRECISION ECMP,PCMP,PMASSP,PVIRTP,GAMBEP, | |
25574 | & SIDP,CODP,SIFP,COFP | |
25575 | COMMON /POPCMS/ ECMP,PCMP,PMASSP(2),PVIRTP(2),GAMBEP(4), | |
25576 | & SIDP,CODP,SIFP,COFP,NPOSP(2), | |
25577 | & IDPDG1,IDBAM1,IDPDG2,IDBAM2 | |
25578 | C Reggeon phenomenology parameters | |
25579 | DOUBLE PRECISION ALPOM,ALPOMP,GP,B0POM,ALREG,ALREGP,GR,B0REG, | |
25580 | & GPPP,GPPR,B0PPP,B0PPR,VDMFAC,VDMQ2F,B0HAR,AKFAC | |
25581 | COMMON /POPREG/ ALPOM,ALPOMP,GP(2),B0POM(2), | |
25582 | & ALREG,ALREGP,GR(2),B0REG(2), | |
25583 | & GPPP,GPPR,B0PPP,B0PPR, | |
25584 | & VDMFAC(4),VDMQ2F(4),B0HAR,AKFAC | |
25585 | C currently activated parton density parametrizations | |
25586 | CHARACTER*8 PDFNAM | |
25587 | INTEGER IPARID,IPAVA,ITYPE,IGRP,ISET,IEXT,NPAOLD | |
25588 | DOUBLE PRECISION PDFLAM,PDFQ2M | |
25589 | COMMON /POPPDF/ PDFLAM(2),PDFQ2M(2),PDFNAM(2),IPARID(2), | |
25590 | & IPAVA(2),ITYPE(2),IGRP(2),ISET(2),IEXT(2),NPAOLD | |
25591 | C hard scattering parameters used for most recent hard interaction | |
25592 | INTEGER NFbeta,NF | |
25593 | DOUBLE PRECISION ALQCD2,BQCD | |
25594 | COMMON /POHAPA/ ALQCD2(3,4),BQCD(4),NFbeta,NF | |
25595 | C some hadron information, will be deleted in future versions | |
25596 | INTEGER NFS | |
25597 | DOUBLE PRECISION QMASS,BET,PCOUDI,PNORM,VALPRG | |
25598 | COMMON /POHDRN/ QMASS(6),BET,PCOUDI,PNORM,VALPRG(2),NFS | |
25599 | C scale parameters for parton model calculations | |
25600 | INTEGER NQQAL,NQQALI,NQQALF,NQQPD | |
25601 | DOUBLE PRECISION AQQAL,AQQALI,AQQALF,AQQPD | |
25602 | COMMON /POHSCL/ AQQAL,AQQALI,AQQALF,AQQPD, | |
25603 | & NQQAL,NQQALI,NQQALF,NQQPD | |
25604 | C some constants | |
25605 | DOUBLE PRECISION PI,PI2,PI4,GEV2MB,Q_ch,Q_ch2,Q_ch4 | |
25606 | COMMON /POCONS/ PI,PI2,PI4,GEV2MB, | |
25607 | & Q_ch(-6:6),Q_ch2(-6:6),Q_ch4(-6:6) | |
25608 | ||
25609 | DOUBLE PRECISION PHO_ALPHAS,pho_alphae | |
25610 | DIMENSION PDA(-6:6),PDB(-6:6),DSIGM(0:Max_pro_2) | |
25611 | ||
25612 | * ONE32=1.D0/9.D0 | |
25613 | * TWO32=4.D0/9.D0 | |
25614 | DO 10 I=10,13 | |
25615 | DSIGMC(I) = CMPLX(0.D0,0.D0) | |
25616 | DSIGM(I) = 0.D0 | |
25617 | 10 CONTINUE | |
25618 | DSIGMC(15) = CMPLX(0.D0,0.D0) | |
25619 | DSIGM(15) = 0.D0 | |
25620 | ||
25621 | C direct particle 1 | |
25622 | IF((IDPDG1.EQ.22).OR.(IDPDG1.EQ.990)) THEN | |
25623 | EC = EXP(ETAC) | |
25624 | ED = ECMH/PT-EC | |
25625 | C kinematic conversions | |
25626 | XA = 1.D0 | |
25627 | XB = 1.D0/(EC*ED) | |
25628 | IF ( XB.GE.1.D0 ) THEN | |
25629 | WRITE(LO,'(/1X,A,2E12.4)') | |
25630 | & 'PHO_HARXD2:ERROR: XB>1 (XA,XB)',XA,XB | |
25631 | RETURN | |
25632 | ENDIF | |
25633 | SP = XA*XB*ECMH*ECMH | |
25634 | UP =-ECMH*PT*EC*XB | |
25635 | UP = UP/SP | |
25636 | TP =-(1.D0+UP) | |
25637 | UU = UP*UP | |
25638 | TT = TP*TP | |
25639 | C set hard scale QQ for alpha and partondistr. | |
25640 | IF ( NQQAL.EQ.1 ) THEN | |
25641 | QQAL = AQQAL*PT*PT | |
25642 | ELSEIF ( NQQAL.EQ.2 ) THEN | |
25643 | QQAL = AQQAL*SP*UP*TP/(1.D0+TT+UU) | |
25644 | ELSEIF ( NQQAL.EQ.3 ) THEN | |
25645 | QQAL = AQQAL*SP | |
25646 | ELSEIF ( NQQAL.EQ.4 ) THEN | |
25647 | QQAL = AQQAL*SP*(UP*TP)**(1.D0/3.D0) | |
25648 | ENDIF | |
25649 | IF ( NQQPD.EQ.1 ) THEN | |
25650 | QQPD = AQQPD*PT*PT | |
25651 | ELSEIF ( NQQPD.EQ.2 ) THEN | |
25652 | QQPD = AQQPD*SP*UP*TP/(1.D0+TT+UU) | |
25653 | ELSEIF ( NQQPD.EQ.3 ) THEN | |
25654 | QQPD = AQQPD*SP | |
25655 | ELSEIF ( NQQPD.EQ.4 ) THEN | |
25656 | QQPD = AQQPD*SP*(UP*TP)**(1.D0/3.D0) | |
25657 | ENDIF | |
25658 | ||
25659 | ALPHA2 = PHO_ALPHAS(QQAL,2) | |
25660 | IF(IDPDG1.EQ.22) THEN | |
25661 | ALPHA1 = pho_alphae(QQAL) | |
25662 | ELSE IF(IDPDG1.EQ.990) THEN | |
25663 | ALPHA1 = PARMDL(74) | |
25664 | ENDIF | |
25665 | FACTOR = -PI2*GEV2MB*UP/PT*ALPHA1*ALPHA2/SP*AKFAC | |
25666 | C parton distribution (times x) | |
25667 | CALL PHO_PDF(2,XB,QQPD,0.D0,PDB) | |
25668 | S1 = PDB(0) | |
25669 | C charge counting | |
25670 | S2 = 0.D0 | |
25671 | S3 = 0.D0 | |
25672 | IF(IDPDG1.EQ.22) THEN | |
25673 | DO 20 I=1,NF | |
25674 | * IF(MOD(I,2).EQ.0) THEN | |
25675 | * S2 = S2 + (PDB(I)+PDB(-I))*TWO32 | |
25676 | * S3 = S3 + TWO32 | |
25677 | * ELSE | |
25678 | * S2 = S2 + (PDB(I)+PDB(-I))*ONE32 | |
25679 | * S3 = S3 + ONE32 | |
25680 | * ENDIF | |
25681 | S2 = S2 + (PDB(I)+PDB(-I))*Q_ch2(I) | |
25682 | S3 = S3 + Q_ch2(I) | |
25683 | 20 CONTINUE | |
25684 | ELSE IF(IDPDG1.EQ.990) THEN | |
25685 | DO 25 I=1,NF | |
25686 | S2 = S2 + PDB(I)+PDB(-I) | |
25687 | 25 CONTINUE | |
25688 | S3 = NF | |
25689 | ENDIF | |
25690 | C partial cross sections (including color and symmetry factors) | |
25691 | C direct photon matrix elements | |
25692 | DSIGM(10) = -8.D0/3.D0*(UU+1.D0)/UP | |
25693 | DSIGM(11) = (UU+TT)/(UP*TP) | |
25694 | C | |
25695 | DSIGM(10) = FACTOR*DSIGM(10)*S2 | |
25696 | DSIGM(11) = FACTOR*DSIGM(11)*S1*S3 | |
25697 | C complex part | |
25698 | X=ABS(TP-UP) | |
25699 | FAC2 = -LOG((X+2.D0)/(X+1.D-30))/PI | |
25700 | C | |
25701 | DO 50 I=10,11 | |
25702 | IF(DSIGM(I).LT.0.D0) THEN | |
25703 | WRITE(LO,'(1X,A,I3,1P,2E12.4)') | |
25704 | & 'PHO_HARXD2: neg. cross section',I,DSIGM(I),ECMH | |
25705 | DSIGM(I) = 0.D0 | |
25706 | ENDIF | |
25707 | DSIGMC(I) = CMPLX(DSIGM(I),DSIGM(I)*FAC2) | |
25708 | DSIGMC(15) = DSIGMC(15)+DSIGMC(I) | |
25709 | 50 CONTINUE | |
25710 | ENDIF | |
25711 | C | |
25712 | C direct particle 2 | |
25713 | IF((IDPDG2.EQ.22).OR.(IDPDG2.EQ.990)) THEN | |
25714 | EC = EXP(ETAC) | |
25715 | ED = 1.D0/(ECMH/PT-1.D0/EC) | |
25716 | C kinematic conversions | |
25717 | XA = PT*(EC+ED)/ECMH | |
25718 | XB = 1.D0 | |
25719 | IF ( XA.GE.1.D0 ) THEN | |
25720 | WRITE(LO,'(/1X,A,2E12.4)') | |
25721 | & 'PHO_HARXD2:ERROR:XA>1 (XA,XB)',XA,XB | |
25722 | RETURN | |
25723 | ENDIF | |
25724 | SP = XA*XB*ECMH*ECMH | |
25725 | UP =-ECMH*PT*EC*XB | |
25726 | UP = UP/SP | |
25727 | TP =-(1.D0+UP) | |
25728 | UU = UP*UP | |
25729 | TT = TP*TP | |
25730 | C set hard scale QQ for alpha and partondistr. | |
25731 | IF ( NQQAL.EQ.1 ) THEN | |
25732 | QQAL = AQQAL*PT*PT | |
25733 | ELSEIF ( NQQAL.EQ.2 ) THEN | |
25734 | QQAL = AQQAL*SP*UP*TP/(1.D0+TT+UU) | |
25735 | ELSEIF ( NQQAL.EQ.3 ) THEN | |
25736 | QQAL = AQQAL*SP | |
25737 | ELSEIF ( NQQAL.EQ.4 ) THEN | |
25738 | QQAL = AQQAL*SP*(UP*TP)**(1.D0/3.D0) | |
25739 | ENDIF | |
25740 | IF ( NQQPD.EQ.1 ) THEN | |
25741 | QQPD = AQQPD*PT*PT | |
25742 | ELSEIF ( NQQPD.EQ.2 ) THEN | |
25743 | QQPD = AQQPD*SP*UP*TP/(1.D0+TT+UU) | |
25744 | ELSEIF ( NQQPD.EQ.3 ) THEN | |
25745 | QQPD = AQQPD*SP | |
25746 | ELSEIF ( NQQPD.EQ.4 ) THEN | |
25747 | QQPD = AQQPD*SP*(UP*TP)**(1.D0/3.D0) | |
25748 | ENDIF | |
25749 | ||
25750 | ALPHA1 = PHO_ALPHAS(QQAL,1) | |
25751 | IF(IDPDG2.EQ.22) THEN | |
25752 | ALPHA2 = pho_alphae(QQAL) | |
25753 | ELSE IF(IDPDG2.EQ.990) THEN | |
25754 | ALPHA2 = PARMDL(74) | |
25755 | ENDIF | |
25756 | FACTOR = -PI2*GEV2MB*TP/PT*ALPHA1*ALPHA2/SP*AKFAC | |
25757 | C parton distribution (times x) | |
25758 | CALL PHO_PDF(1,XA,QQPD,0.D0,PDA) | |
25759 | S1 = PDA(0) | |
25760 | C charge counting | |
25761 | S2 = 0.D0 | |
25762 | S3 = 0.D0 | |
25763 | IF(IDPDG2.EQ.22) THEN | |
25764 | DO 70 I=1,NF | |
25765 | * IF(MOD(I,2).EQ.0) THEN | |
25766 | * S2 = S2 + (PDA(I)+PDA(-I))*TWO32 | |
25767 | * S3 = S3 + TWO32 | |
25768 | * ELSE | |
25769 | * S2 = S2 + (PDA(I)+PDA(-I))*ONE32 | |
25770 | * S3 = S3 + ONE32 | |
25771 | * ENDIF | |
25772 | S2 = S2 + (PDA(I)+PDA(-I))*Q_ch2(I) | |
25773 | S3 = S3 + Q_ch2(I) | |
25774 | 70 CONTINUE | |
25775 | ELSE IF(IDPDG2.EQ.990) THEN | |
25776 | DO 75 I=1,NF | |
25777 | S2 = S2 + PDA(I)+PDA(-I) | |
25778 | 75 CONTINUE | |
25779 | S3 = NF | |
25780 | ENDIF | |
25781 | C partial cross sections (including color and symmetry factors) | |
25782 | C direct photon matrix elements | |
25783 | DSIGM(12) = -8.D0/3.D0*(TT+1.D0)/TP | |
25784 | DSIGM(13) = (UU+TT)/(UP*TP) | |
25785 | C | |
25786 | DSIGM(12) = FACTOR*DSIGM(12)*S2 | |
25787 | DSIGM(13) = FACTOR*DSIGM(13)*S3*S1 | |
25788 | C complex part | |
25789 | X=ABS(TP-UP) | |
25790 | FAC2 = -LOG((X+2.D0)/(X+1.D-30))/PI | |
25791 | C | |
25792 | DO 80 I=12,13 | |
25793 | IF(DSIGM(I).LT.0.D0) THEN | |
25794 | WRITE(LO,'(1X,A,I3,1P,2E12.4)') | |
25795 | & 'PHO_HARXD2: neg. cross section:',I,DSIGM(I),ECMH | |
25796 | DSIGM(I) = 0.D0 | |
25797 | ENDIF | |
25798 | DSIGMC(I) = CMPLX(DSIGM(I),DSIGM(I)*FAC2) | |
25799 | DSIGMC(15) = DSIGMC(15)+DSIGMC(I) | |
25800 | 80 CONTINUE | |
25801 | ENDIF | |
25802 | END | |
25803 | ||
25804 | *$ CREATE PHO_HARXPT.FOR | |
25805 | *COPY PHO_HARXPT | |
25806 | CDECK ID>, PHO_HARXPT | |
25807 | SUBROUTINE PHO_HARXPT(ECMH,PT,IPRO,DSIGMC) | |
25808 | C********************************************************************** | |
25809 | C | |
25810 | C differential cross section DSIG/DPT | |
25811 | C | |
25812 | C input: ECMH CMS energy of scattering system | |
25813 | C PT parton PT | |
25814 | C IPRO 1 resolved processes | |
25815 | C 2 direct processes | |
25816 | C 3 resolved and direct processes | |
25817 | C | |
25818 | C output: DSIGMC(0:12) QCD-PM cross sections dsigma/dpt | |
25819 | C | |
25820 | C********************************************************************** | |
25821 | IMPLICIT DOUBLE PRECISION (A-H,O-Z) | |
25822 | SAVE | |
25823 | ||
25824 | PARAMETER ( Max_pro_2 = 16 ) | |
25825 | COMPLEX*16 DSIGMC | |
25826 | DIMENSION DSIGMC(0:Max_pro_2) | |
25827 | PARAMETER ( TINY= 1.D-10, ONEP1=1.1, EPS=1.D-25) | |
25828 | ||
25829 | C input/output channels | |
25830 | INTEGER LI,LO | |
25831 | COMMON /POINOU/ LI,LO | |
25832 | C some constants | |
25833 | DOUBLE PRECISION PI,PI2,PI4,GEV2MB,Q_ch,Q_ch2,Q_ch4 | |
25834 | COMMON /POCONS/ PI,PI2,PI4,GEV2MB, | |
25835 | & Q_ch(-6:6),Q_ch2(-6:6),Q_ch4(-6:6) | |
25836 | C model switches and parameters | |
25837 | CHARACTER*8 MDLNA | |
25838 | INTEGER ISWMDL,IPAMDL | |
25839 | DOUBLE PRECISION PARMDL | |
25840 | COMMON /POMDLS/ MDLNA(50),ISWMDL(50),PARMDL(400),IPAMDL(400) | |
25841 | C data of c.m. system of Pomeron / Reggeon exchange | |
25842 | INTEGER NPOSP,IDPDG1,IDBAM1,IDPDG2,IDBAM2 | |
25843 | DOUBLE PRECISION ECMP,PCMP,PMASSP,PVIRTP,GAMBEP, | |
25844 | & SIDP,CODP,SIFP,COFP | |
25845 | COMMON /POPCMS/ ECMP,PCMP,PMASSP(2),PVIRTP(2),GAMBEP(4), | |
25846 | & SIDP,CODP,SIFP,COFP,NPOSP(2), | |
25847 | & IDPDG1,IDBAM1,IDPDG2,IDBAM2 | |
25848 | C Reggeon phenomenology parameters | |
25849 | DOUBLE PRECISION ALPOM,ALPOMP,GP,B0POM,ALREG,ALREGP,GR,B0REG, | |
25850 | & GPPP,GPPR,B0PPP,B0PPR,VDMFAC,VDMQ2F,B0HAR,AKFAC | |
25851 | COMMON /POPREG/ ALPOM,ALPOMP,GP(2),B0POM(2), | |
25852 | & ALREG,ALREGP,GR(2),B0REG(2), | |
25853 | & GPPP,GPPR,B0PPP,B0PPR, | |
25854 | & VDMFAC(4),VDMQ2F(4),B0HAR,AKFAC | |
25855 | C integration precision for hard cross sections (obsolete) | |
25856 | INTEGER NGAUP1,NGAUP2,NGAUET,NGAUIN,NGAUSO | |
25857 | COMMON /POGAUP/ NGAUP1,NGAUP2,NGAUET,NGAUIN,NGAUSO | |
25858 | C hard scattering parameters used for most recent hard interaction | |
25859 | INTEGER NFbeta,NF | |
25860 | DOUBLE PRECISION ALQCD2,BQCD | |
25861 | COMMON /POHAPA/ ALQCD2(3,4),BQCD(4),NFbeta,NF | |
25862 | C some hadron information, will be deleted in future versions | |
25863 | INTEGER NFS | |
25864 | DOUBLE PRECISION QMASS,BET,PCOUDI,PNORM,VALPRG | |
25865 | COMMON /POHDRN/ QMASS(6),BET,PCOUDI,PNORM,VALPRG(2),NFS | |
25866 | ||
25867 | double precision pho_alphae | |
25868 | ||
25869 | COMPLEX*16 DSIG1 | |
25870 | DIMENSION DSIG1(0:Max_pro_2) | |
25871 | DIMENSION ABSZ(32),WEIG(32) | |
25872 | ||
25873 | DO 10 M=0,Max_pro_2 | |
25874 | DSIGMC(M) = CMPLX(0.D0,0.D0) | |
25875 | DSIG1(M) = CMPLX(0.D0,0.D0) | |
25876 | 10 CONTINUE | |
25877 | ||
25878 | C resolved and direct processes | |
25879 | AMT = 2.D0*PT/ECMH | |
25880 | IF ( AMT.GE.1.D0 ) RETURN | |
25881 | ECU = LOG((SQRT(1.D0-AMT*AMT)+1.D0)/AMT) | |
25882 | ECL = -ECU | |
25883 | NPOINT = NGAUET | |
25884 | CALL PHO_GAUSET(ECL,ECU,NPOINT,ABSZ,WEIG) | |
25885 | DO 30 I=1,NPOINT | |
25886 | DSIG1(9) = CMPLX(0.D0,0.D0) | |
25887 | DSIG1(15) = CMPLX(0.D0,0.D0) | |
25888 | IF(IPRO.EQ.1) THEN | |
25889 | CALL PHO_HARXR2(ECMH,PT,ABSZ(I),DSIG1) | |
25890 | ELSE IF(IPRO.EQ.2) THEN | |
25891 | CALL PHO_HARXD2(ECMH,PT,ABSZ(I),DSIG1) | |
25892 | ELSE | |
25893 | CALL PHO_HARXR2(ECMH,PT,ABSZ(I),DSIG1) | |
25894 | CALL PHO_HARXD2(ECMH,PT,ABSZ(I),DSIG1) | |
25895 | ENDIF | |
25896 | DO 20 M=1,Max_pro_2 | |
25897 | DSIGMC(M) = DSIGMC(M)+WEIG(I)*DSIG1(M) | |
25898 | 20 CONTINUE | |
25899 | 30 CONTINUE | |
25900 | ||
25901 | C direct processes | |
25902 | IF(((IDPDG1.EQ.22).OR.(IDPDG1.EQ.990)) | |
25903 | & .AND.((IDPDG2.EQ.22).OR.(IDPDG2.EQ.990))) THEN | |
25904 | FAC = 0.D0 | |
25905 | SS = ECMH*ECMH | |
25906 | ALPHAE = pho_alphae(SS) | |
25907 | DO 300 I=1,NF | |
25908 | IF(IDPDG1.EQ.22) THEN | |
25909 | * F1 = (4.D0-3.D0*MOD(I,2))/9.D0*ALPHAE | |
25910 | F1 = Q_ch2(I)*ALPHAE | |
25911 | ELSE | |
25912 | F1 = PARMDL(74) | |
25913 | ENDIF | |
25914 | IF(IDPDG2.EQ.22) THEN | |
25915 | * F2 = (4.D0-3.D0*MOD(I,2))/9.D0*ALPHAE | |
25916 | F2 = Q_ch2(I)*ALPHAE | |
25917 | ELSE | |
25918 | F2 = PARMDL(74) | |
25919 | ENDIF | |
25920 | FAC = FAC+F1*F2*3.D0 | |
25921 | 300 CONTINUE | |
25922 | C direct cross sections | |
25923 | ZZ = SQRT(1.D0-4.D0*PT*PT/SS+TINY) | |
25924 | T1 = -SS/2.D0*(1.D0+ZZ) | |
25925 | T2 = -SS/2.D0*(1.D0-ZZ) | |
25926 | XM = -2.D0*PT/ZZ*((SS+T1)/T1+T1/(SS+T1)+(SS+T2)/T2+T2/(SS+T2)) | |
25927 | C hadronic part | |
25928 | DSIGMC(14) = GEV2MB*2.D0*PI*FAC/(SS*SS)*XM*AKFAC | |
25929 | ||
25930 | C leptonic part (e, mu, tau) | |
25931 | DSIGMC(16) = 0.D0 | |
25932 | IF((IDPDG1.EQ.22).AND.(IDPDG2.EQ.22)) THEN | |
25933 | DSIGMC(16) = DSIGMC(14)/FAC*3.D0*ALPHAE**2 | |
25934 | C simulation of tau together with quarks | |
25935 | IF(IPAMDL(64).NE.0) DSIGMC(14) = DSIGMC(14)+DSIGMC(16)/3.D0 | |
25936 | ENDIF | |
25937 | ENDIF | |
25938 | ||
25939 | DSIGMC(15) = DSIGMC(15)+DSIGMC(14) | |
25940 | DSIGMC(0) = DSIGMC(9)+DSIGMC(15) | |
25941 | ||
25942 | END | |
25943 | ||
25944 | *$ CREATE PHO_HARXTO.FOR | |
25945 | *COPY PHO_HARXTO | |
25946 | CDECK ID>, PHO_HARXTO | |
25947 | SUBROUTINE PHO_HARXTO(ECMH,PTCUTR,PTCUTD,DSIGMC,DSDPTC) | |
25948 | C********************************************************************** | |
25949 | C | |
25950 | C total hard cross section (perturbative QCD, Parton Model) | |
25951 | C | |
25952 | C input: ECMH CMS energy of scattering system | |
25953 | C PTCUTR PT cutoff for resolved processes | |
25954 | C PTCUTD PT cutoff for direct processes (photon, Pomeron) | |
25955 | C | |
25956 | C output: DSIGMC(0:MARPR2) cross sections for given cutoff | |
25957 | C DSDPTC(0:MARPR2) differential cross sections at cutoff | |
25958 | C | |
25959 | C note: COMPLEX*16 DSIGMC | |
25960 | C DOUBLE PRECISION DSDPTC | |
25961 | C | |
25962 | C********************************************************************** | |
25963 | IMPLICIT DOUBLE PRECISION (A-H,O-Z) | |
25964 | SAVE | |
25965 | ||
25966 | PARAMETER ( Max_pro_2 = 16 ) | |
25967 | COMPLEX*16 DSIGMC | |
25968 | DIMENSION DSIGMC(0:Max_pro_2),DSDPTC(0:Max_pro_2) | |
25969 | ||
25970 | C input/output channels | |
25971 | INTEGER LI,LO | |
25972 | COMMON /POINOU/ LI,LO | |
25973 | C model switches and parameters | |
25974 | CHARACTER*8 MDLNA | |
25975 | INTEGER ISWMDL,IPAMDL | |
25976 | DOUBLE PRECISION PARMDL | |
25977 | COMMON /POMDLS/ MDLNA(50),ISWMDL(50),PARMDL(400),IPAMDL(400) | |
25978 | C data of c.m. system of Pomeron / Reggeon exchange | |
25979 | INTEGER NPOSP,IDPDG1,IDBAM1,IDPDG2,IDBAM2 | |
25980 | DOUBLE PRECISION ECMP,PCMP,PMASSP,PVIRTP,GAMBEP, | |
25981 | & SIDP,CODP,SIFP,COFP | |
25982 | COMMON /POPCMS/ ECMP,PCMP,PMASSP(2),PVIRTP(2),GAMBEP(4), | |
25983 | & SIDP,CODP,SIFP,COFP,NPOSP(2), | |
25984 | & IDPDG1,IDBAM1,IDPDG2,IDBAM2 | |
25985 | C Reggeon phenomenology parameters | |
25986 | DOUBLE PRECISION ALPOM,ALPOMP,GP,B0POM,ALREG,ALREGP,GR,B0REG, | |
25987 | & GPPP,GPPR,B0PPP,B0PPR,VDMFAC,VDMQ2F,B0HAR,AKFAC | |
25988 | COMMON /POPREG/ ALPOM,ALPOMP,GP(2),B0POM(2), | |
25989 | & ALREG,ALREGP,GR(2),B0REG(2), | |
25990 | & GPPP,GPPR,B0PPP,B0PPR, | |
25991 | & VDMFAC(4),VDMQ2F(4),B0HAR,AKFAC | |
25992 | C some constants | |
25993 | DOUBLE PRECISION PI,PI2,PI4,GEV2MB,Q_ch,Q_ch2,Q_ch4 | |
25994 | COMMON /POCONS/ PI,PI2,PI4,GEV2MB, | |
25995 | & Q_ch(-6:6),Q_ch2(-6:6),Q_ch4(-6:6) | |
25996 | C integration precision for hard cross sections (obsolete) | |
25997 | INTEGER NGAUP1,NGAUP2,NGAUET,NGAUIN,NGAUSO | |
25998 | COMMON /POGAUP/ NGAUP1,NGAUP2,NGAUET,NGAUIN,NGAUSO | |
25999 | C some hadron information, will be deleted in future versions | |
26000 | INTEGER NFS | |
26001 | DOUBLE PRECISION QMASS,BET,PCOUDI,PNORM,VALPRG | |
26002 | COMMON /POHDRN/ QMASS(6),BET,PCOUDI,PNORM,VALPRG(2),NFS | |
26003 | C hard scattering parameters used for most recent hard interaction | |
26004 | INTEGER NFbeta,NF | |
26005 | DOUBLE PRECISION ALQCD2,BQCD | |
26006 | COMMON /POHAPA/ ALQCD2(3,4),BQCD(4),NFbeta,NF | |
26007 | ||
26008 | double precision pho_alphae | |
26009 | ||
26010 | COMPLEX*16 DSIG1 | |
26011 | DIMENSION DSIG1(0:Max_pro_2) | |
26012 | DIMENSION ABSZ(32),WEIG(32) | |
26013 | ||
26014 | DATA FAC / 3.0D0 / | |
26015 | ||
26016 | DO 10 M=0,Max_pro_2 | |
26017 | DSIGMC(M)= CMPLX(0.D0,0.D0) | |
26018 | 10 CONTINUE | |
26019 | EEC=ECMH/2.001D0 | |
26020 | C | |
26021 | IF ( PTCUTR.GE.EEC ) GOTO 100 | |
26022 | C | |
26023 | C integration for resolved processes | |
26024 | PTMIN = PTCUTR | |
26025 | PTMAX = MIN(FAC*PTMIN,EEC) | |
26026 | NPOINT = NGAUP1 | |
26027 | CALL PHO_HARXPT(ECMH,PTMIN,1,DSIG1) | |
26028 | DO 60 M=1,9 | |
26029 | DSDPTC(M) = DREAL(DSIG1(M)) | |
26030 | 60 CONTINUE | |
26031 | DSIGH = DREAL(DSIG1(9)) | |
26032 | PTMXX = 0.95D0*PTMAX | |
26033 | CALL PHO_HARXPT(ECMH,PTMXX,1,DSIG1) | |
26034 | DSIGL = DREAL(DSIG1(9)) | |
26035 | EX = LOG(DSIGH/(DSIGL+1.D-30))/LOG(FAC) | |
26036 | EX1 = 1.0D0-EX | |
26037 | DO 50 K=1,2 | |
26038 | IF ( PTMIN.GE.PTMAX ) GOTO 40 | |
26039 | RL = PTMIN**EX1 | |
26040 | RU = PTMAX**EX1 | |
26041 | CALL PHO_GAUSET(RL,RU,NPOINT,ABSZ,WEIG) | |
26042 | DO 30 I=1,NPOINT | |
26043 | R = ABSZ(I) | |
26044 | PT = R**(1.0D0/EX1) | |
26045 | CALL PHO_HARXPT(ECMH,PT,1,DSIG1) | |
26046 | F = WEIG(I)*PT/(R*EX1) | |
26047 | DO 20 M=1,9 | |
26048 | DSIGMC(M) = DSIGMC(M)+F*DSIG1(M) | |
26049 | 20 CONTINUE | |
26050 | 30 CONTINUE | |
26051 | 40 PTMIN = PTMAX | |
26052 | PTMAX = EEC | |
26053 | NPOINT = NGAUP2 | |
26054 | 50 CONTINUE | |
26055 | 100 CONTINUE | |
26056 | DSIGMC(0) = DSIGMC(9) | |
26057 | DSDPTC(0) = DSDPTC(9) | |
26058 | C | |
26059 | C integration for direct processes | |
26060 | IF((PTCUTD.GE.EEC).OR.(PTCUTD.LT.0.5D0)) RETURN | |
26061 | C | |
26062 | IF((IDPDG1.EQ.22).OR.(IDPDG1.EQ.990) | |
26063 | & .OR.(IDPDG2.EQ.22).OR.(IDPDG2.EQ.990)) THEN | |
26064 | PTMIN = PTCUTD | |
26065 | PTMAX = MIN(FAC*PTMIN,EEC) | |
26066 | NPOINT = NGAUP1 | |
26067 | CALL PHO_HARXPT(ECMH,PTMIN,2,DSIG1) | |
26068 | IF(DREAL(DSIG1(15)).LT.1.D-15) GOTO 170 | |
26069 | DO 160 M=10,16 | |
26070 | DSDPTC(M) = DREAL(DSIG1(M)) | |
26071 | 160 CONTINUE | |
26072 | DSIGH = DREAL(DSIG1(15)-DSIG1(14)) | |
26073 | PTMXX = 0.95D0*PTMAX | |
26074 | CALL PHO_HARXPT(ECMH,PTMXX,2,DSIG1) | |
26075 | DSIGL = DREAL(DSIG1(15)-DSIG1(14)) | |
26076 | EX = LOG(DSIGH/(DSIGL+1.D-30))/LOG(FAC) | |
26077 | EX1 = 1.0D0-EX | |
26078 | DO 150 K=1,2 | |
26079 | IF ( PTMIN.GE.PTMAX ) GOTO 140 | |
26080 | RL = PTMIN**EX1 | |
26081 | RU = PTMAX**EX1 | |
26082 | CALL PHO_GAUSET(RL,RU,NPOINT,ABSZ,WEIG) | |
26083 | DO 130 I=1,NPOINT | |
26084 | R = ABSZ(I) | |
26085 | PT = R**(1.0D0/EX1) | |
26086 | CALL PHO_HARXPT(ECMH,PT,2,DSIG1) | |
26087 | F = WEIG(I)*PT/(R*EX1) | |
26088 | DO 120 M=10,15 | |
26089 | DSIGMC(M) = DSIGMC(M)+F*DSIG1(M) | |
26090 | 120 CONTINUE | |
26091 | 130 CONTINUE | |
26092 | 140 PTMIN = PTMAX | |
26093 | PTMAX = EEC | |
26094 | NPOINT = NGAUP2 | |
26095 | 150 CONTINUE | |
26096 | ENDIF | |
26097 | C | |
26098 | 170 CONTINUE | |
26099 | C | |
26100 | C double direct process | |
26101 | IF(((IDPDG1.EQ.22).OR.(IDPDG1.EQ.990)) | |
26102 | & .AND.((IDPDG2.EQ.22).OR.(IDPDG2.EQ.990))) THEN | |
26103 | FACC = 0.D0 | |
26104 | SS = ECMH*ECMH | |
26105 | ALPHAE = pho_alphae(SS) | |
26106 | DO 300 I=1,NF | |
26107 | IF(IDPDG1.EQ.22) THEN | |
26108 | * F1 = (4.D0-3.D0*MOD(I,2))/9.D0*ALPHAE | |
26109 | F1 = Q_ch2(I)*ALPHAE | |
26110 | ELSE | |
26111 | F1 = PARMDL(74) | |
26112 | ENDIF | |
26113 | IF(IDPDG2.EQ.22) THEN | |
26114 | * F2 = (4.D0-3.D0*MOD(I,2))/9.D0*ALPHAE | |
26115 | F2 = Q_ch2(I)*ALPHAE | |
26116 | ELSE | |
26117 | F2 = PARMDL(74) | |
26118 | ENDIF | |
26119 | FACC = FACC + F1*F2*3.D0 | |
26120 | 300 CONTINUE | |
26121 | ||
26122 | ZZ = SQRT(1.D0-4.D0*PTCUTD*PTCUTD/SS) | |
26123 | R = 4.D0*PI/SS*(LOG((1.D0+ZZ)/(1.D0-ZZ))-ZZ)*GEV2MB | |
26124 | C hadronic cross section | |
26125 | DSIGMC(14) = R*FACC*AKFAC | |
26126 | C leptonic cross section | |
26127 | IF((IDPDG1.EQ.22).AND.(IDPDG2.EQ.22)) THEN | |
26128 | DSIGMC(16) = R*3.D0*ALPHAE**2*AKFAC | |
26129 | C simulation of tau together with quarks | |
26130 | IF(IPAMDL(64).NE.0) DSIGMC(14) = DSIGMC(14)+DSIGMC(16)/3.D0 | |
26131 | DSIGMC(16) = DSIGMC(16)*2.D0/3.D0 | |
26132 | ELSE | |
26133 | DSIGMC(16) = CMPLX(0.D0,0.D0) | |
26134 | ENDIF | |
26135 | C sum of direct part | |
26136 | DSIGMC(15) = CMPLX(0.D0,0.D0) | |
26137 | DO 400 I=10,14 | |
26138 | DSIGMC(15) = DSIGMC(15) + DSIGMC(I) | |
26139 | 400 CONTINUE | |
26140 | ENDIF | |
26141 | C total sum (hadronic) | |
26142 | DSIGMC(0) = DSIGMC(9) + DSIGMC(15) | |
26143 | DSDPTC(0) = DSDPTC(9) + DSDPTC(15) | |
26144 | ||
26145 | END | |
26146 | ||
26147 | *$ CREATE PHO_HARISR.FOR | |
26148 | *COPY PHO_HARISR | |
26149 | CDECK ID>, PHO_HARISR | |
26150 | SUBROUTINE PHO_HARISR(IHPOM,P1,P2,IPF1,IPF2,IPA1,IPA2,IV1,IV2,Q2H, | |
26151 | & XH1,XH2,XHMAX1,XHMAX2,IPB1,IPB2,IVO1,IVO2,XISR1,XISR2,IREJ) | |
26152 | C******************************************************************** | |
26153 | C | |
26154 | C initial state radiation according to DGLAP evolution equations | |
26155 | C (backward evolution, no spin effects) | |
26156 | C | |
26157 | C input: IHPOM index of hard Pomeron | |
26158 | C negative: delete all previous entries | |
26159 | C P1,P2 4 momenta of hard scattered final partons | |
26160 | C (in CMS of hard scattering) | |
26161 | C IPF1,2 flavours of final partons | |
26162 | C IPA1,2 flavours of initial partons | |
26163 | C IV1,2 valence quark labels (0/1) | |
26164 | C Q2H momentum transfer (squared, positive) | |
26165 | C XH1,XH2 x values of initial partons | |
26166 | C XHMAX1,2 max. x values allowed | |
26167 | C | |
26168 | C output: all emitted partons in /POPISR/, final state | |
26169 | C partons are the first two entries | |
26170 | C shower evolution traced in /PODGL1/ | |
26171 | C IPB1,2 flavours of new initial partons | |
26172 | C XISR1,2 x values of new initial partons | |
26173 | C IVO1,2 valence quark labels (0/1) | |
26174 | C | |
26175 | C attention: quark numbering according to PDG convention, | |
26176 | C but 0 for gluons | |
26177 | C | |
26178 | C******************************************************************** | |
26179 | IMPLICIT DOUBLE PRECISION (A-H,O-Z) | |
26180 | SAVE | |
26181 | ||
26182 | PARAMETER (RHOMAS = 0.766D0, | |
26183 | & DEPS = 1.D-10, | |
26184 | & TINY = 1.D-10) | |
26185 | ||
26186 | DIMENSION P1(4),P2(4) | |
26187 | ||
26188 | C input/output channels | |
26189 | INTEGER LI,LO | |
26190 | COMMON /POINOU/ LI,LO | |
26191 | C event debugging information | |
26192 | INTEGER NMAXD | |
26193 | PARAMETER (NMAXD=100) | |
26194 | INTEGER IDEB,KSPOM,KHPOM,KSREG,KHDIR,KACCEP,KSTRG,KHTRG,KSLOO, | |
26195 | & KHLOO,KSDPO,KHDPO,KEVENT,KSOFT,KHARD | |
26196 | COMMON /PODEBG/ IDEB(NMAXD),KSPOM,KHPOM,KSREG,KHDIR,KACCEP,KSTRG, | |
26197 | & KHTRG,KSLOO,KHLOO,KSDPO,KHDPO,KEVENT,KSOFT,KHARD | |
26198 | C internal rejection counters | |
26199 | INTEGER NMXJ | |
26200 | PARAMETER (NMXJ=60) | |
26201 | CHARACTER*10 REJTIT | |
26202 | INTEGER IFAIL | |
26203 | COMMON /POLOOP/ IFAIL(NMXJ),REJTIT(NMXJ) | |
26204 | C model switches and parameters | |
26205 | CHARACTER*8 MDLNA | |
26206 | INTEGER ISWMDL,IPAMDL | |
26207 | DOUBLE PRECISION PARMDL | |
26208 | COMMON /POMDLS/ MDLNA(50),ISWMDL(50),PARMDL(400),IPAMDL(400) | |
26209 | C data of c.m. system of Pomeron / Reggeon exchange | |
26210 | INTEGER NPOSP,IDPDG1,IDBAM1,IDPDG2,IDBAM2 | |
26211 | DOUBLE PRECISION ECMP,PCMP,PMASSP,PVIRTP,GAMBEP, | |
26212 | & SIDP,CODP,SIFP,COFP | |
26213 | COMMON /POPCMS/ ECMP,PCMP,PMASSP(2),PVIRTP(2),GAMBEP(4), | |
26214 | & SIDP,CODP,SIFP,COFP,NPOSP(2), | |
26215 | & IDPDG1,IDBAM1,IDPDG2,IDBAM2 | |
26216 | C some hadron information, will be deleted in future versions | |
26217 | INTEGER NFS | |
26218 | DOUBLE PRECISION QMASS,BET,PCOUDI,PNORM,VALPRG | |
26219 | COMMON /POHDRN/ QMASS(6),BET,PCOUDI,PNORM,VALPRG(2),NFS | |
26220 | C currently activated parton density parametrizations | |
26221 | CHARACTER*8 PDFNAM | |
26222 | INTEGER IPARID,IPAVA,ITYPE,IGRP,ISET,IEXT,NPAOLD | |
26223 | DOUBLE PRECISION PDFLAM,PDFQ2M | |
26224 | COMMON /POPPDF/ PDFLAM(2),PDFQ2M(2),PDFNAM(2),IPARID(2), | |
26225 | & IPAVA(2),ITYPE(2),IGRP(2),ISET(2),IEXT(2),NPAOLD | |
26226 | C scale parameters for parton model calculations | |
26227 | INTEGER NQQAL,NQQALI,NQQALF,NQQPD | |
26228 | DOUBLE PRECISION AQQAL,AQQALI,AQQALF,AQQPD | |
26229 | COMMON /POHSCL/ AQQAL,AQQALI,AQQALF,AQQPD, | |
26230 | & NQQAL,NQQALI,NQQALF,NQQPD | |
26231 | C parameters for DGLAP backward evolution in ISR | |
26232 | INTEGER NFSISR | |
26233 | DOUBLE PRECISION Q2MISR,PMISR,ZMISR,AL2ISR | |
26234 | COMMON /PODGL1/ Q2MISR(2),PMISR(2),ZMISR(2),AL2ISR(2),NFSISR | |
26235 | C initial state parton radiation (internal part) | |
26236 | INTEGER MXISR3,MXISR4 | |
26237 | PARAMETER ( MXISR3 = 50, MXISR4 = 100 ) | |
26238 | INTEGER IFL1,IFL2,IBRA,IFANO,ISH,NACC | |
26239 | DOUBLE PRECISION Q2SH,PT2SH,XPSH,ZPSH,THSH,SHAT | |
26240 | COMMON /POINT6/ Q2SH(2,MXISR3),PT2SH(2,MXISR3),XPSH(2,MXISR3), | |
26241 | & ZPSH(2,MXISR3),THSH(2,MXISR3),SHAT(MXISR3), | |
26242 | & IFL1(2,MXISR3),IFL2(2,MXISR3), | |
26243 | & IBRA(2,MXISR4),IFANO(2),ISH(2),NACC | |
26244 | C some constants | |
26245 | DOUBLE PRECISION PI,PI2,PI4,GEV2MB,Q_ch,Q_ch2,Q_ch4 | |
26246 | COMMON /POCONS/ PI,PI2,PI4,GEV2MB, | |
26247 | & Q_ch(-6:6),Q_ch2(-6:6),Q_ch4(-6:6) | |
26248 | C particles created by initial state evolution | |
26249 | INTEGER MXISR1,MXISR2 | |
26250 | PARAMETER ( MXISR1 = 150, MXISR2 = 50 ) | |
26251 | INTEGER IFLISR,IPOISR,IMXISR | |
26252 | DOUBLE PRECISION PHISR | |
26253 | COMMON /POPISR/ IFLISR(2,MXISR1),PHISR(2,4,MXISR1), | |
26254 | & IPOISR(2,2,MXISR2),IMXISR(2) | |
26255 | ||
26256 | DOUBLE PRECISION PYP,EER,THER,QMAXR | |
26257 | INTEGER PYK | |
26258 | ||
26259 | DIMENSION XHMA(2),NEXT(2),PD1(-6:6),PD2(-6:6),WGGAP(-6:6), | |
26260 | & WGPDF(-6:6),XHMI(2),GB(4),PM(4),PN(4),PC(2,4),Q2(2), | |
26261 | & IVAL(2),IPAL(2),IL(2),IFSUM(2),IDMO(2) | |
26262 | ||
26263 | IREJ = 0 | |
26264 | NTRY = 1000 | |
26265 | NITER = 0 | |
26266 | C debug output | |
26267 | IF(IDEB(79).GE.10) THEN | |
26268 | WRITE(LO,'(1X,A,/1X,I10,3I3,5E11.3,2(/5X,4E12.3))') | |
26269 | & 'PHO_HARISR: KEV,IHPOM,IP1,IP2,Q2H,XH1,XH2,XHM1,XHM2:', | |
26270 | & KEVENT,IHPOM,IPA1,IPA2,Q2H,XH1,XH2,XHMAX1,XHMAX2,P1,P2 | |
26271 | ENDIF | |
26272 | IF(IHPOM.EQ.0) RETURN | |
26273 | C | |
26274 | 10 CONTINUE | |
26275 | NACC = 0 | |
26276 | IDMO(1) = IDPDG1 | |
26277 | IDMO(2) = IDPDG2 | |
26278 | C | |
26279 | C copy final state partons to local fields | |
26280 | IHIDX = ABS(IHPOM) | |
26281 | IF(IHIDX.GT.MXISR2) THEN | |
26282 | WRITE(LO,'(1X,2A,2I4)') 'PHO_HARISR: no space left in ', | |
26283 | & '/POPISR/ for hard scattering labels (IHIDX,MXISR2):', | |
26284 | & IHIDX,MXISR2 | |
26285 | IREJ = 1 | |
26286 | ENDIF | |
26287 | DO 50 K=1,2 | |
26288 | IF(IHPOM.LT.0) IMXISR(K) = 0 | |
26289 | IPOISR(K,1,IHIDX) = IMXISR(K)+1 | |
26290 | IPAL(K) = IPOISR(K,1,IHIDX) | |
26291 | 50 CONTINUE | |
26292 | DO 55 I=1,4 | |
26293 | PHISR(1,I,IPAL(1)) = P1(I) | |
26294 | PHISR(2,I,IPAL(2)) = P2(I) | |
26295 | 55 CONTINUE | |
26296 | IFLISR(1,IPAL(1)) = IPF1 | |
26297 | IFLISR(2,IPAL(2)) = IPF2 | |
26298 | C | |
26299 | C check limitations, initialize /PODGL1/ | |
26300 | IF((Q2H.GT.Q2MISR(1)).AND.(XH1.LT.XHMAX1)) THEN | |
26301 | NEXT(1) = 1 | |
26302 | Q2SH(1,1) = Q2H | |
26303 | ELSE | |
26304 | NEXT(1) = 0 | |
26305 | Q2SH(1,1) = 0.D0 | |
26306 | ENDIF | |
26307 | IF((Q2H.GT.Q2MISR(2)).AND.(XH2.LT.XHMAX2)) THEN | |
26308 | NEXT(2) = 1 | |
26309 | Q2SH(2,1) = Q2H | |
26310 | ELSE | |
26311 | NEXT(2) = 0 | |
26312 | Q2SH(2,1) = 0.D0 | |
26313 | ENDIF | |
26314 | C | |
26315 | ISH(1) = 1 | |
26316 | ISH(2) = 1 | |
26317 | XPSH(1,1) = XH1 | |
26318 | XPSH(2,1) = XH2 | |
26319 | C | |
26320 | IFL1(1,1) = IPA1 | |
26321 | IVAL(1) = IV1 | |
26322 | IF((IPA1.EQ.22).OR.(IPA1.EQ.990)) NEXT(1) = 0 | |
26323 | IFL1(2,1) = IPA2 | |
26324 | IVAL(2) = IV2 | |
26325 | IF((IPA2.EQ.22).OR.(IPA2.EQ.990)) NEXT(2) = 0 | |
26326 | C | |
26327 | IF(IDEB(79).GE.17) WRITE(LO,'(1X,A,/5X,2I2,3E12.3)') | |
26328 | & 'PHO_HARISR:INITIAL TESTS (NEXT1,2 Q2H Q21,2)',NEXT,Q2H,Q2MISR | |
26329 | IF(NEXT(1)+NEXT(2).EQ.0) GOTO 800 | |
26330 | C | |
26331 | C initialize parton shower loop | |
26332 | B0QCD = (33.D0-2.D0*NFSISR)/6.D0 | |
26333 | AL2ISR(1) = PDFLAM(1) | |
26334 | AL2ISR(2) = PDFLAM(2) | |
26335 | XHMA(1) = XHMAX1 | |
26336 | XHMA(2) = XHMAX2 | |
26337 | XHMI(1) = PMISR(1)/PCMP | |
26338 | XHMI(2) = PMISR(2)/PCMP | |
26339 | ZPSH(1,1) = 1.D0 | |
26340 | ZPSH(2,1) = 1.D0 | |
26341 | SHAT1 = XH1*XH2*ECMP**2 | |
26342 | IF(IPAMDL(109).EQ.1) THEN | |
26343 | PT2SH(1,1) = Q2H | |
26344 | ELSE | |
26345 | PT2SH(1,1) = Q2H*(1.D0-Q2H/SHAT1) | |
26346 | ENDIF | |
26347 | PT2SH(2,1) = PT2SH(1,1) | |
26348 | IF(PT2SH(1,1).LT.Q2MISR(1)) NEXT(1) = 0 | |
26349 | IF(PT2SH(2,1).LT.Q2MISR(2)) NEXT(2) = 0 | |
26350 | THSH(1,1) = 2.D0*SQRT(Q2H/SHAT1) | |
26351 | THSH(2,1) = THSH(1,1) | |
26352 | IFANO(1) = 0 | |
26353 | IFANO(2) = 0 | |
26354 | ZZ = 1.D0 | |
26355 | IF(IREJ.NE.0) GOTO 800 | |
26356 | C | |
26357 | C main generation loop | |
26358 | C ------------------------------------------------- | |
26359 | 100 CONTINUE | |
26360 | C choose parton side to become solved | |
26361 | IF((NEXT(1)+NEXT(2)).EQ.2) THEN | |
26362 | IF(Q2SH(1,ISH(1)).GT.Q2SH(2,ISH(2))) THEN | |
26363 | IP = 1 | |
26364 | ELSE IF(Q2SH(2,ISH(2)).GT.Q2SH(1,ISH(1))) THEN | |
26365 | IP = 2 | |
26366 | ELSE | |
26367 | IP = MAX(INT(DT_RNDM(SHAT1)*2.D0+0.999999D0),1) | |
26368 | ENDIF | |
26369 | ELSE IF(NEXT(1).EQ.1) THEN | |
26370 | IP = 1 | |
26371 | ELSE IF(NEXT(2).EQ.1) THEN | |
26372 | IP = 2 | |
26373 | ELSE | |
26374 | GOTO 800 | |
26375 | ENDIF | |
26376 | INDX = ISH(IP) | |
26377 | C INDX now parton position of parton to become solved | |
26378 | C IP now side to be treated | |
26379 | XP = XPSH(IP,INDX) | |
26380 | Q2P = Q2SH(IP,INDX) | |
26381 | PT2 = PT2SH(IP,INDX) | |
26382 | IFLB = IFL1(IP,INDX) | |
26383 | C check available x | |
26384 | XMIP = XHMI(IP) | |
26385 | C cutoff by x limitation: no further development | |
26386 | IF((XHMA(IP)-XP).LT.XMIP*2.D0) THEN | |
26387 | NEXT(IP) = 0 | |
26388 | Q2SH(IP,INDX) = 0.D0 | |
26389 | IF(IDEB(79).GE.17) THEN | |
26390 | WRITE(LO,'(1X,A,/5X,3E12.4,2I3)') | |
26391 | & 'PHO_HARISR: evolution x-stop (XP,XMIP,XHMA,IP,INDX)', | |
26392 | & XP,XMIP,XHMA(IP),IP,INDX | |
26393 | ENDIF | |
26394 | GOTO 100 | |
26395 | ENDIF | |
26396 | C initial value of evolution variable t | |
26397 | TT = LOG(AQQALI*Q2P/AL2ISR(IP)) | |
26398 | DO 110 I=-NFSISR,NFSISR | |
26399 | WGGAP(I) = 0.D0 | |
26400 | WGPDF(I) = 0.D0 | |
26401 | 110 CONTINUE | |
26402 | C DGLAP weights | |
26403 | ZMIN = XP/XHMA(IP) | |
26404 | ZMAX = XP/(XP+XMIP) | |
26405 | CF = 4./3. | |
26406 | C q --> q g, g --> g g | |
26407 | IF(IFLB.EQ.0) THEN | |
26408 | WGGAP(0) = CF*((ZMAX**2-ZMIN**2)/2.D0-2.D0*(ZMAX-ZMIN) | |
26409 | & +2.D0*LOG(ZMAX/ZMIN)) | |
26410 | DO 120 I=1,NFSISR | |
26411 | WGGAP(I) = WGGAP(0) | |
26412 | WGGAP(-I) = WGGAP(0) | |
26413 | 120 CONTINUE | |
26414 | WGGAP(0) = 6.D0*((ZMIN**3-ZMAX**3)/3.D0+(ZMAX**2-ZMIN**2)/2.D0 | |
26415 | & -2.D0*(ZMAX-ZMIN)+LOG(ZMAX/ZMIN*(1.D0-ZMIN)/(1.D0-ZMAX))) | |
26416 | C q --> g q, g --> q qb | |
26417 | ELSE IF(ABS(IFLB).LE.6) THEN | |
26418 | WGGAP(IFLB) = CF*((ZMIN**2-ZMAX**2)/2.D0-ZMAX+ZMIN | |
26419 | & -2.D0*LOG((1.D0-ZMAX)/(1.D0-ZMIN))) | |
26420 | IF(IVAL(IP).EQ.0) WGGAP(0) = 0.5D0*(2./3.*(ZMAX**3-ZMIN**3) | |
26421 | & -ZMAX**2+ZMIN**2+ZMAX-ZMIN) | |
26422 | ELSE | |
26423 | WRITE(LO,'(/1X,A,I7)') | |
26424 | & 'PHO_HARISR:ERROR: unsupported particle ID',IFLB | |
26425 | CALL PHO_ABORT | |
26426 | ENDIF | |
26427 | C anomalous/resolved evolution | |
26428 | IPDFC = 0 | |
26429 | IF(IPAMDL(110).GE.1) THEN | |
26430 | IF((IDMO(IP).EQ.22).AND.(IFLB.NE.0) | |
26431 | & .AND.(IFLB.NE.21)) THEN | |
26432 | WGDIR = 0.D0 | |
26433 | IF(NQQALI.EQ.1) THEN | |
26434 | SCALE2 = PT2*AQQPD | |
26435 | ELSE | |
26436 | SCALE2 = Q2P*AQQPD | |
26437 | ENDIF | |
26438 | CALL PHO_PDF(IP,XP,SCALE2,0.D0,PD1) | |
26439 | IPDFC = 1 | |
26440 | CALL PHO_QPMPDF(IFLB,XP,SCALE2,PTA1,PVIRTP(IP),WGDIR) | |
26441 | XI = DT_RNDM(XP)*PD1(IFLB) | |
26442 | IF(WGDIR.GT.XI) THEN | |
26443 | C debug output | |
26444 | IF(IDEB(79).GE.17) WRITE(LO,'(1X,2A,/5X,4E12.5,I2,I3)') | |
26445 | & 'PHO_HARISR: ', | |
26446 | & 'direct splitting (WGDIR,WGPDF,X,SCALE2,IP,IFLB)', | |
26447 | & WGDIR,PD1(IFLB),XP,SCALE2,IP,IFLB | |
26448 | Q2SH(IP,INDX) = 0.D0 | |
26449 | NEXT(IP) = 0 | |
26450 | IFANO(IP) = INDX | |
26451 | GOTO 100 | |
26452 | ENDIF | |
26453 | ENDIF | |
26454 | ENDIF | |
26455 | C | |
26456 | C rejection loop for z,t sampling | |
26457 | C ------------------------------------ | |
26458 | 200 CONTINUE | |
26459 | NITER = NITER+1 | |
26460 | IF(NITER.GE.NTRY) THEN | |
26461 | WRITE(LO,'(1X,A,2I6)') | |
26462 | & 'PHO_HARISR: too many rejections',NITER,NTRY | |
26463 | CALL PHO_PREVNT(-1) | |
26464 | C clean up event | |
26465 | IREJ = 1 | |
26466 | GOTO 10 | |
26467 | ENDIF | |
26468 | C PDF weights | |
26469 | IF(IPDFC.EQ.0) THEN | |
26470 | IF(NQQALI.EQ.1) THEN | |
26471 | SCALE2 = PT2*AQQPD | |
26472 | ELSE | |
26473 | SCALE2 = Q2P*AQQPD | |
26474 | ENDIF | |
26475 | CALL PHO_PDF(IP,XP,SCALE2,0.D0,PD1) | |
26476 | ENDIF | |
26477 | IPDFC = 0 | |
26478 | C | |
26479 | WGTOT = 0.D0 | |
26480 | DO 210 I=-NFSISR,NFSISR | |
26481 | WGPDF(I) = PD1(I)/(PD1(IFLB)+1.D-12)*5.D0 | |
26482 | WGTOT = WGTOT+WGPDF(I)*WGGAP(I) | |
26483 | 210 CONTINUE | |
26484 | C | |
26485 | 215 CONTINUE | |
26486 | C sample new t value | |
26487 | TT = TT*EXP(MAX(-10.D0,LOG(DT_RNDM(SHAT1))*B0QCD/WGTOT)) | |
26488 | Q2NEW = AL2ISR(IP)*EXP(TT)/AQQALI | |
26489 | C debug output | |
26490 | IF(IDEB(79).GE.20) WRITE(LO,'(1X,A,E12.5)') | |
26491 | & 'PHO_HARISR: pre-selected Q2:',Q2NEW | |
26492 | C compare to limits | |
26493 | IF(Q2NEW.LT.Q2MISR(IP)) THEN | |
26494 | Q2SH(IP,INDX) = 0.D0 | |
26495 | NEXT(IP) = 0 | |
26496 | IF(IDEB(79).GE.17) WRITE(LO,'(1X,A,2E10.3,2I3)') | |
26497 | & 'PHO_HARISR: evolution Q2-stop (Q2,Q2MIN,IP,INDX):', | |
26498 | & Q2NEW,Q2MISR(IP),IP,INDX | |
26499 | GOTO 100 | |
26500 | ENDIF | |
26501 | Q2SH(IP,INDX) = Q2NEW | |
26502 | TT = LOG(AQQALI*Q2NEW/AL2ISR(IP)) | |
26503 | C selection of flavours | |
26504 | XI = WGTOT*DT_RNDM(TT) | |
26505 | IFLA = -NFSISR-1 | |
26506 | 220 CONTINUE | |
26507 | IFLA = IFLA+1 | |
26508 | XI = XI-WGPDF(IFLA)*WGGAP(IFLA) | |
26509 | IF((XI.GT.0.D0).AND.(IFLA.LT.NFSISR)) GOTO 220 | |
26510 | C debug output | |
26511 | IF(IDEB(79).GE.20) WRITE(LO,'(1X,A,2I3)') | |
26512 | & 'PHO_HARISR: pre-selected IFLA (IFLA,IFLB):',IFLA,IFLB | |
26513 | C selection of z | |
26514 | CALL PHO_HARZSP(IFLA,IFLB,NFSISR,ZMIN,ZMAX,ZZ) | |
26515 | C debug output | |
26516 | IF(IDEB(79).GE.20) WRITE(LO,'(1X,A,E12.3)') | |
26517 | & 'PHO_HARISR: pre-selected ZZ',ZZ | |
26518 | C angular ordering | |
26519 | THETA = 4.D0*ZZ**2*Q2NEW/((ECMP*XP)**2*(1.D0-ZZ)) | |
26520 | IF(THETA.GT.THSH(IP,INDX)) THEN | |
26521 | IF(IDEB(79).GE.20) WRITE(LO,'(1X,A,2E12.3)') | |
26522 | & 'PHO_HARISR: reject by angle (NEW/OLD)', | |
26523 | & THETA,THSH(IP,INDX) | |
26524 | GOTO 215 | |
26525 | ENDIF | |
26526 | C rejection weight given by new PDFs | |
26527 | XNEW = XP/ZZ | |
26528 | PT2NEW = Q2NEW*(1.D0-ZZ) | |
26529 | IF(NQQALI.EQ.1) THEN | |
26530 | SCALE2 = PT2NEW*AQQPD | |
26531 | ELSE | |
26532 | SCALE2 = Q2NEW*AQQPD | |
26533 | ENDIF | |
26534 | IF(SCALE2.LT.Q2MISR(IP)) THEN | |
26535 | Q2SH(IP,INDX) = 0.D0 | |
26536 | NEXT(IP) = 0 | |
26537 | IF(IDEB(79).GE.17) WRITE(LO,'(1X,A,2E10.3,2I3)') | |
26538 | & 'PHO_HARISR: evol.Q2-stop (SCALE2,Q2MIN,IP,INDX):', | |
26539 | & Q2NEW,Q2MISR(IP),IP,INDX | |
26540 | GOTO 100 | |
26541 | ENDIF | |
26542 | CALL PHO_PDF(IP,XNEW,SCALE2,0.D0,PD2) | |
26543 | IF(PD2(IFLA).LT.1.D-10) GOTO 200 | |
26544 | CALL PHO_PDF(IP,XP,SCALE2,0.D0,PD1) | |
26545 | PD1(IFLB) = MAX(PD1(IFLB),1.D-10) | |
26546 | WGF = PD2(IFLA)/PD1(IFLB)/(WGPDF(IFLA)+1.D-12) | |
26547 | IF(NQQALI.EQ.1) WGF = WGF*LOG(Q2NEW*AQQALI/AL2ISR(IP)) | |
26548 | & /LOG(PT2NEW*AQQALI/AL2ISR(IP)) | |
26549 | IF((WGF.GT.1.D0).AND.(IDEB(79).GE.2)) THEN | |
26550 | WRITE(LO,'(1X,A,E12.3)') | |
26551 | & 'PHO_HARISR: final weight:',WGF | |
26552 | WRITE(LO,'(6X,A,I7,2I3,3E11.3)') | |
26553 | & 'EV,IFLA,IFLB,Q2,PT2,Z:',KEVENT,IFLA,IFLB,Q2NEW,PT2NEW,ZZ | |
26554 | ENDIF | |
26555 | IF(WGF.LT.DT_RNDM(XNEW)) GOTO 200 | |
26556 | ||
26557 | IF(IDEB(79).GE.15) THEN | |
26558 | WRITE(LO,'(1X,A,/3X,3I3,3E11.3)') | |
26559 | & 'PHO_HARISR: accepted IP,IFLA,IFLB,PT2,Q2,Z:', | |
26560 | & IP,IFLA,IFLB,PT2NEW,Q2NEW,ZZ | |
26561 | ENDIF | |
26562 | ||
26563 | IF(INDX.GE.MXISR3) THEN | |
26564 | WRITE(LO,'(1X,2A,2I4)') 'PHO_HARISR: no space left in ', | |
26565 | & '/POINT6/ for parton radiation (INDX,MXISR3):',INDX,MXISR3 | |
26566 | IREJ = 1 | |
26567 | RETURN | |
26568 | ENDIF | |
26569 | C branching accepted, registration | |
26570 | Q2SH(IP,INDX) = Q2NEW | |
26571 | PT2SH(IP,INDX) = PT2NEW | |
26572 | ZPSH(IP,INDX) = ZZ | |
26573 | IFL2(IP,INDX) = IFLA-IFLB | |
26574 | Q2SH(IP,INDX+1) = Q2NEW | |
26575 | PT2SH(IP,INDX+1) = PT2SH(IP,INDX) | |
26576 | XPSH(IP,INDX+1) = XNEW | |
26577 | THSH(IP,INDX+1) = THETA | |
26578 | IFL1(IP,INDX+1) = IFLA | |
26579 | ISH(IP) = ISH(IP)+1 | |
26580 | ||
26581 | NACC = NACC+1 | |
26582 | IF(NACC.GT.MXISR4) THEN | |
26583 | WRITE(LO,'(1X,2A,2I4)') 'PHO_HARISR: no space left in ', | |
26584 | & '/POINT6/ for parton radiation (NACC,MXISR4):',NACC,MXISR4 | |
26585 | IREJ = 1 | |
26586 | RETURN | |
26587 | ENDIF | |
26588 | SHAT(NACC) = SHAT1 | |
26589 | IBRA(1,NACC) = IP | |
26590 | IBRA(2,NACC) = INDX | |
26591 | SHAT1 = SHAT1/ZZ | |
26592 | ||
26593 | C generation of next branching | |
26594 | IF(NEXT(1)+NEXT(2).NE.0) GOTO 100 | |
26595 | ||
26596 | 800 CONTINUE | |
26597 | ||
26598 | C new initial flavours, x values | |
26599 | IPB1 = IFL1(1,ISH(1)) | |
26600 | IPB2 = IFL1(2,ISH(2)) | |
26601 | XISR1 = XPSH(1,ISH(1)) | |
26602 | XISR2 = XPSH(2,ISH(2)) | |
26603 | IVO1 = IVAL(1) | |
26604 | IVO2 = IVAL(2) | |
26605 | C valence flavours | |
26606 | IF(IPB1.NE.0) THEN | |
26607 | IF(ISH(1).GT.1) THEN | |
26608 | CALL PHO_PDF(1,XISR1,Q2MISR(1),0.D0,PD1) | |
26609 | IF(IDPDG1.EQ.22) THEN | |
26610 | CALL PHO_QPMPDF(IPB1,XISR1,Q2MISR(1),0.D0,PVIRTP(1),FXP) | |
26611 | IF(DT_RNDM(XISR1)*PD1(IPB1).GT.PD1(IPB1)-FXP) IVAL(1) = 1 | |
26612 | ELSE | |
26613 | CALL PHO_PDF(1,XISR1,Q2MISR(1),0.D0,PD1) | |
26614 | IF(DT_RNDM(XISR1)*PD1(IPB1).GT.PD1(-IPB1)) IVAL(1) = 1 | |
26615 | ENDIF | |
26616 | ENDIF | |
26617 | ENDIF | |
26618 | IF(IPB2.NE.0) THEN | |
26619 | IF(ISH(2).GT.1) THEN | |
26620 | CALL PHO_PDF(2,XISR2,Q2MISR(2),0.D0,PD1) | |
26621 | IF(IDPDG2.EQ.22) THEN | |
26622 | CALL PHO_QPMPDF(IPB2,XISR2,Q2MISR(2),0.D0,PVIRTP(2),FXP) | |
26623 | IF(DT_RNDM(XISR2)*PD1(IPB2).GT.PD1(IPB2)-FXP) IVAL(2) = 1 | |
26624 | ELSE | |
26625 | IF(DT_RNDM(XISR2)*PD1(IPB2).GT.PD1(-IPB2)) IVAL(2) = 1 | |
26626 | ENDIF | |
26627 | ENDIF | |
26628 | ENDIF | |
26629 | ||
26630 | C parton kinematics | |
26631 | IF(NACC.GT.0) THEN | |
26632 | C final partons in CMS | |
26633 | PM(3) = (XH1-XH2)*ECMP/2.D0 | |
26634 | PM(4) = (XH1+XH2)*ECMP/2.D0 | |
26635 | SH = XH1*XH2*ECMP**2 | |
26636 | SSH = SQRT(SH) | |
26637 | GB(3) = PM(3)/SSH | |
26638 | GB(4) = PM(4)/SSH | |
26639 | CALL PHO_ALTRA(GB(4),0.D0,0.D0,-GB(3),P1(1),P1(2),P1(3), | |
26640 | & P1(4),PTOT1,PHISR(1,1,IPAL(1)),PHISR(1,2,IPAL(1)), | |
26641 | & PHISR(1,3,IPAL(1)),PHISR(1,4,IPAL(1))) | |
26642 | CALL PHO_ALTRA(GB(4),0.D0,0.D0,-GB(3),P2(1),P2(2),P2(3), | |
26643 | & P2(4),PTOT1,PHISR(2,1,IPAL(2)),PHISR(2,2,IPAL(2)), | |
26644 | & PHISR(2,3,IPAL(2)),PHISR(2,4,IPAL(2))) | |
26645 | IL(1) = 1 | |
26646 | IL(2) = 1 | |
26647 | DO 900 I=1,NACC | |
26648 | IPA = IBRA(1,I) | |
26649 | IPB = 3-IPA | |
26650 | IL(IPA) = IBRA(2,I) | |
26651 | C new initial partons in CMS | |
26652 | SH = SHAT(I) | |
26653 | SSH = SQRT(SH) | |
26654 | SHZ = SH/ZPSH(IPA,IL(IPA)) | |
26655 | SSHZ = SQRT(SHZ) | |
26656 | Q2(1) = Q2SH(1,IL(1)) | |
26657 | Q2(2) = Q2SH(2,IL(2)) | |
26658 | PC(1,1) = 0.D0 | |
26659 | PC(1,2) = 0.D0 | |
26660 | PC(1,3) = SQRT((SH+Q2(1)+Q2(2))**2-4.D0*Q2(1)*Q2(2)) | |
26661 | & /(2.D0*SSH) | |
26662 | PC(1,4) = (SH-Q2(1)+Q2(2))/(2.D0*SSH) | |
26663 | PC(2,1) = 0.D0 | |
26664 | PC(2,2) = 0.D0 | |
26665 | PC(2,3) = -PC(1,3) | |
26666 | PC(2,4) = SSH-PC(1,4) | |
26667 | XMS4 = PHO_PMASS(IFL2(IPA,IL(IPA)),1)**2 | |
26668 | EE3 = (SHZ-Q2(IPA)+Q2(IPB)-XMS4)/(2.D0*SSH) | |
26669 | S1 = SH+Q2(IPA)+Q2(IPB) | |
26670 | S3 = SHZ+Q2(IPB)+Q2SH(IPA,IL(IPA)+1) | |
26671 | R1 = SQRT(S1**2-4.D0*Q2(IPA)*Q2(IPB)) | |
26672 | R3 = SQRT(S3**2-4.D0*Q2(IPB)*Q2SH(IPA,IL(IPA)+1)) | |
26673 | IF(Q2(IPB).LT.0.1D0) THEN | |
26674 | XMS4M = (Q2(IPA)/ZPSH(IPA,IL(IPA))-Q2SH(IPA,IL(IPA)+1)) | |
26675 | & *(SH/(SH+Q2(IPA))-SH/(SHZ+Q2SH(IPA,IL(IPA)+1))) | |
26676 | ELSE | |
26677 | XMS4M = (S1*S3-R1*R3)/(2.D0*Q2(IPB)) | |
26678 | & -Q2(IPA)-Q2SH(IPA,IL(IPA)+1) | |
26679 | ENDIF | |
26680 | NGEN = 1 | |
26681 | C max. virtuality for time-like showers | |
26682 | QMAX = MIN(XMS4M,PARMDL(95)*Q2(IPA)) | |
26683 | IF((IPAMDL(111).GE.1).AND.(QMAX.GT.PARMDL(94))) THEN | |
26684 | C generate time-like parton shower | |
26685 | KF = IFL2(IPA,IL(IPA)) | |
26686 | IF(KF.EQ.0) KF = 21 | |
26687 | EER = MIN(EE3-PC(IPA,4),ECMP) | |
26688 | THER = 0. | |
26689 | CALL PY1ENT(1,KF,EER,THER,THER) | |
26690 | QMAXR = SQRT(QMAX) | |
26691 | CALL PYSHOW(1,0,QMAXR) | |
26692 | C debug output | |
26693 | IF(IDEB(79).GE.25) THEN | |
26694 | WRITE(LO,'(1X,2A,/,5X,1P,4E12.4)') 'PHO_HARISR: ', | |
26695 | & 'PYSHOW called for EE,QMAX,XMS4M,Q2(IPA)', | |
26696 | & EER,QMAX,XMS4M,Q2(IPA) | |
26697 | CALL PYLIST(1) | |
26698 | ENDIF | |
26699 | NGEN = PYK(0,1) | |
26700 | IF(NGEN.GT.1) THEN | |
26701 | PJX = 0.D0 | |
26702 | PJY = 0.D0 | |
26703 | PJZ = 0.D0 | |
26704 | PJE = 0.D0 | |
26705 | KK = IPAL(IPA) | |
26706 | DO 820 K=3,NGEN | |
26707 | IF(PYK(K,1).LE.4) THEN | |
26708 | KK = KK+1 | |
26709 | IF(KK.GT.MXISR1) THEN | |
26710 | WRITE(LO,'(1X,2A,2I5)') 'PHO_HARISR: no space ', | |
26711 | & 'left in /POPISR/ (KK,MXISR1):',KK,MXISR1 | |
26712 | IREJ = 1 | |
26713 | RETURN | |
26714 | ENDIF | |
26715 | PHISR(IPA,1,KK) = PYP(K,1) | |
26716 | PJX = PJX+PHISR(IPA,1,KK) | |
26717 | PHISR(IPA,2,KK) = PYP(K,2) | |
26718 | PJY = PJY+PHISR(IPA,2,KK) | |
26719 | PHISR(IPA,3,KK) = PYP(K,3) | |
26720 | PJZ = PJZ+PHISR(IPA,3,KK) | |
26721 | PHISR(IPA,4,KK) = PYP(K,4) | |
26722 | PJE = PJE+PHISR(IPA,4,KK) | |
26723 | IFLISR(IPA,KK) = PYK(K,2) | |
26724 | IF(IFLISR(IPA,KK).EQ.21) IFLISR(IPA,KK) = 0 | |
26725 | IF(IFLISR(IPA,KK).EQ.5) IFLISR(IPA,KK) = 3 | |
26726 | IF(IFLISR(IPA,KK).EQ.-5) IFLISR(IPA,KK) = -3 | |
26727 | ENDIF | |
26728 | 820 CONTINUE | |
26729 | NGEN = KK-IPAL(IPA) | |
26730 | XMS4 = (PJE+PJZ)*(PJE-PJZ)-PJX**2-PJY**2 | |
26731 | PP4 = SQRT(PJE**2-XMS4) | |
26732 | EE3 = (SHZ-Q2(IPA)+Q2(IPB)-XMS4)/(2.D0*SSH) | |
26733 | C debug output | |
26734 | IF(IDEB(79).GE.20) WRITE(LO,'(1X,2A,/,5X,1P,6E12.4)') | |
26735 | & 'PHO_HARISR: ', | |
26736 | & 'time-like shower: PJE,PJX,PJY,PJZ,PP4,XMS4', | |
26737 | & PJE,PJX,PJY,PJZ,PP4,XMS4 | |
26738 | ENDIF | |
26739 | ENDIF | |
26740 | PZ3 = (2.D0*PC(IPA,4)*EE3+Q2(IPA)+Q2SH(IPA,IL(IPA)+1)+XMS4) | |
26741 | & /(2.D0*PC(IPA,3)) | |
26742 | PT3 = (EE3+PZ3)*(EE3-PZ3)+Q2SH(IPA,IL(IPA)+1) | |
26743 | IF(PT3.LT.0.D0) THEN | |
26744 | IF(IDEB(79).GE.5) WRITE(LO,'(1X,A,E12.3)') | |
26745 | & 'PHO_HARISR: rejection due to PT3',PT3 | |
26746 | GOTO 10 | |
26747 | ENDIF | |
26748 | PT3 = SQRT(PT3) | |
26749 | CALL PHO_SFECFE(SFE,CFE) | |
26750 | PX3 = CFE*PT3 | |
26751 | PY3 = SFE*PT3 | |
26752 | C | |
26753 | IF(NGEN.GT.1) THEN | |
26754 | C time-like shower generated | |
26755 | EE4 = EE3-PC(IPA,4) | |
26756 | PZ4 = PZ3-PC(IPA,3) | |
26757 | PP4 = SQRT(PT3**2+PZ4**2) | |
26758 | C Lorentz boost | |
26759 | GAM = (EE4*PJE-PP4*PJZ)/XMS4 | |
26760 | BEG = (PJE*PP4-EE4*PJZ)/XMS4 | |
26761 | C rotation angles | |
26762 | CODD = PZ4/PP4 | |
26763 | SIDD = SQRT(PX3**2+PY3**2)/PP4 | |
26764 | COFD = 1.D0 | |
26765 | SIFD = 0.D0 | |
26766 | IF(PP4*SIDD.GT.1.D-5) THEN | |
26767 | COFD = PX3/(SIDD*PP4) | |
26768 | SIFD = PY3/(SIDD*PP4) | |
26769 | ANORF = SQRT(COFD*COFD+SIFD*SIFD) | |
26770 | COFD = COFD/ANORF | |
26771 | SIFD = SIFD/ANORF | |
26772 | ENDIF | |
26773 | C copy partons back | |
26774 | KK = IPAL(IPA) | |
26775 | DO 830 K=1,NGEN | |
26776 | KK = KK+1 | |
26777 | PX = PHISR(IPA,1,KK) | |
26778 | PY = PHISR(IPA,2,KK) | |
26779 | PZ = PHISR(IPA,3,KK) | |
26780 | COH= PHISR(IPA,4,KK) | |
26781 | EE = GAM*COH+BEG*PZ | |
26782 | PZ = GAM*PZ +BEG*COH | |
26783 | PHISR(IPA,4,KK) = EE | |
26784 | CALL PHO_TRANS(PX,PY,PZ,CODD,SIDD,COFD,SIFD, | |
26785 | & PHISR(IPA,1,KK),PHISR(IPA,2,KK),PHISR(IPA,3,KK)) | |
26786 | 830 CONTINUE | |
26787 | IPAL(IPA) = KK | |
26788 | ELSE | |
26789 | C no time-like shower generated | |
26790 | IPAL(IPA) = IPAL(IPA)+1 | |
26791 | PHISR(IPA,1,IPAL(IPA)) = PX3 | |
26792 | PHISR(IPA,2,IPAL(IPA)) = PY3 | |
26793 | PHISR(IPA,3,IPAL(IPA)) = PZ3-PC(IPA,3) | |
26794 | PHISR(IPA,4,IPAL(IPA)) = EE3-PC(IPA,4) | |
26795 | IFLISR(IPA,IPAL(IPA)) = IFL2(IPA,IL(IPA)) | |
26796 | ENDIF | |
26797 | PC(IPA,1) = PX3 | |
26798 | PC(IPA,2) = PY3 | |
26799 | PC(IPA,3) = PZ3 | |
26800 | PC(IPA,4) = EE3 | |
26801 | C boost / rotate into new CMS | |
26802 | DO 842 K=1,4 | |
26803 | GB(K) = (PC(1,K)+PC(2,K))/SSHZ | |
26804 | 842 CONTINUE | |
26805 | CALL PHO_ALTRA(GB(4),-GB(1),-GB(2),-GB(3),PC(1,1),PC(1,2), | |
26806 | & PC(1,3),PC(1,4),PTOT1,PM(1),PM(2),PM(3),PM(4)) | |
26807 | COG= PM(3)/PTOT1 | |
26808 | SIG= SQRT(PM(1)**2+PM(2)**2)/PTOT1 | |
26809 | COH=1.D0 | |
26810 | SIH=0.D0 | |
26811 | IF(PTOT1*SIG.GT.1.D-5) THEN | |
26812 | COH=PM(1)/(SIG*PTOT1) | |
26813 | SIH=PM(2)/(SIG*PTOT1) | |
26814 | ANORF=SQRT(COH*COH+SIH*SIH) | |
26815 | COH=COH/ANORF | |
26816 | SIH=SIH/ANORF | |
26817 | ENDIF | |
26818 | DO 845 K=1,2 | |
26819 | DO 844 L=IPOISR(K,1,IHIDX),IPAL(K) | |
26820 | CALL PHO_ALTRA(GB(4),-GB(1),-GB(2),-GB(3), | |
26821 | & PHISR(K,1,L),PHISR(K,2,L),PHISR(K,3,L),PHISR(K,4,L), | |
26822 | & PTOT1,PM(1),PM(2),PM(3),PM(4)) | |
26823 | CALL PHO_TRANI(PM(1),PM(2),PM(3),COG,SIG,COH,SIH,PN(1), | |
26824 | & PN(2),PN(3)) | |
26825 | CALL PHO_TRANS(PN(1),PN(2),PN(3),1.D0,0.D0,COH,SIH, | |
26826 | & PHISR(K,1,L),PHISR(K,2,L),PHISR(K,3,L)) | |
26827 | PHISR(K,4,L) = PM(4) | |
26828 | 844 CONTINUE | |
26829 | 845 CONTINUE | |
26830 | 900 CONTINUE | |
26831 | C boost back to global CMS | |
26832 | PM(3) = (XISR1-XISR2)/2.D0 | |
26833 | PM(4) = (XISR1+XISR2)/2.D0 | |
26834 | SSH = SQRT(XISR1*XISR2) | |
26835 | GB(3) = PM(3)/SSH | |
26836 | GB(4) = PM(4)/SSH | |
26837 | DO 945 K=1,2 | |
26838 | DO 944 L=IPOISR(K,1,IHIDX),IPAL(K) | |
26839 | CALL PHO_ALTRA(GB(4),0.D0,0.D0,GB(3),PHISR(K,1,L), | |
26840 | & PHISR(K,2,L),PHISR(K,3,L),PHISR(K,4,L),PTOT1,PM(1), | |
26841 | & PM(2),PM(3),PM(4)) | |
26842 | PHISR(K,1,L) = PM(1) | |
26843 | PHISR(K,2,L) = PM(2) | |
26844 | PHISR(K,3,L) = PM(3) | |
26845 | PHISR(K,4,L) = PM(4) | |
26846 | 944 CONTINUE | |
26847 | 945 CONTINUE | |
26848 | ENDIF | |
26849 | IPOISR(1,2,IHIDX) = IPAL(1) | |
26850 | IPOISR(2,2,IHIDX) = IPAL(2) | |
26851 | IMXISR(1) = IPAL(1) | |
26852 | IMXISR(2) = IPAL(2) | |
26853 | C | |
26854 | C debug output | |
26855 | IF(IDEB(79).GE.10) THEN | |
26856 | WRITE(LO,'(1X,A,2I10/,6X,A,2E12.3,2I5)') 'NUMBER OF EMISSIONS', | |
26857 | & ISH(1)-1,ISH(2)-1,'NEW X1,X2,IFL1,ILF2',XISR1,XISR2,IPB1,IPB2 | |
26858 | IF(NACC.GT.0) THEN | |
26859 | WRITE(LO,'(1X,A,2I5,/6X,A)') | |
26860 | & 'PHO_HARISR: ISR configuration (NITER,NACC)',NITER,NACC, | |
26861 | & ' SIDE NO. IFLB IFLC Q2SH PT2SH XH ZZ' | |
26862 | DO 600 II=1,NACC | |
26863 | K = IBRA(1,II) | |
26864 | I = IBRA(2,II) | |
26865 | WRITE(LO,'(5X,4I5,4E11.3)') | |
26866 | & K,I,IFL1(K,I),IFL2(K,I),Q2SH(K,I),PT2SH(K,I),XPSH(K,I), | |
26867 | & ZPSH(K,I) | |
26868 | 600 CONTINUE | |
26869 | ENDIF | |
26870 | C check of final configuration | |
26871 | PX3 = 0.D0 | |
26872 | PY3 = 0.D0 | |
26873 | PZ3 = 0.D0 | |
26874 | EE3 = 0.D0 | |
26875 | IFSUM(1) = 0 | |
26876 | IFSUM(2) = 0 | |
26877 | WRITE(LO,'(1X,A)') 'PHO_HARISR: outgoing partons' | |
26878 | DO 745 K=1,2 | |
26879 | DO 744 L=IPOISR(K,1,IHIDX),IPOISR(K,2,IHIDX) | |
26880 | WRITE(LO,'(6X,2I4,I6,4E11.3)') K,L,IFLISR(K,L), | |
26881 | & PHISR(K,1,L),PHISR(K,2,L),PHISR(K,3,L),PHISR(K,4,L) | |
26882 | IFSUM(K) = IFSUM(K)+ IFLISR(K,L) | |
26883 | PX3 = PX3 + PHISR(K,1,L) | |
26884 | PY3 = PY3 + PHISR(K,2,L) | |
26885 | PZ3 = PZ3 + PHISR(K,3,L) | |
26886 | EE3 = EE3 + PHISR(K,4,L) | |
26887 | 744 CONTINUE | |
26888 | 745 CONTINUE | |
26889 | IFSUM(1) = IFSUM(1)-IPB1 | |
26890 | IFSUM(2) = IFSUM(2)-IPB2 | |
26891 | PZ3 = PZ3 -(XISR1-XISR2)*ECMP/2.D0 | |
26892 | EE3 = EE3 -(XISR1+XISR2)*ECMP/2.D0 | |
26893 | WRITE(LO,'(1X,A,2I4,4E11.3)') 'CHECK:IFL1,2 PCM(1-4)', | |
26894 | & IFSUM,PX3,PY3,PZ3,EE3 | |
26895 | ENDIF | |
26896 | END | |
26897 | ||
26898 | *$ CREATE PHO_HARZSP.FOR | |
26899 | *COPY PHO_HARZSP | |
26900 | CDECK ID>, PHO_HARZSP | |
26901 | SUBROUTINE PHO_HARZSP(IFLA,IFLB,NFSH,ZMIN,ZMAX,ZZ) | |
26902 | C********************************************************************* | |
26903 | C | |
26904 | C sampling of z values from DGLAP kernels | |
26905 | C | |
26906 | C input: IFLA,IFLB parton flavours | |
26907 | C NFSH flavours involved in hard processes | |
26908 | C ZMIN minimal ZZ allowed | |
26909 | C ZMAX maximal ZZ allowed | |
26910 | C | |
26911 | C output: ZZ z value | |
26912 | C | |
26913 | C********************************************************************* | |
26914 | IMPLICIT DOUBLE PRECISION (A-H,O-Z) | |
26915 | SAVE | |
26916 | ||
26917 | PARAMETER ( DEPS = 1.D-10 ) | |
26918 | ||
26919 | C input/output channels | |
26920 | INTEGER LI,LO | |
26921 | COMMON /POINOU/ LI,LO | |
26922 | C event debugging information | |
26923 | INTEGER NMAXD | |
26924 | PARAMETER (NMAXD=100) | |
26925 | INTEGER IDEB,KSPOM,KHPOM,KSREG,KHDIR,KACCEP,KSTRG,KHTRG,KSLOO, | |
26926 | & KHLOO,KSDPO,KHDPO,KEVENT,KSOFT,KHARD | |
26927 | COMMON /PODEBG/ IDEB(NMAXD),KSPOM,KHPOM,KSREG,KHDIR,KACCEP,KSTRG, | |
26928 | & KHTRG,KSLOO,KHLOO,KSDPO,KHDPO,KEVENT,KSOFT,KHARD | |
26929 | C internal rejection counters | |
26930 | INTEGER NMXJ | |
26931 | PARAMETER (NMXJ=60) | |
26932 | CHARACTER*10 REJTIT | |
26933 | INTEGER IFAIL | |
26934 | COMMON /POLOOP/ IFAIL(NMXJ),REJTIT(NMXJ) | |
26935 | ||
26936 | IF(ZMAX.LE.ZMIN) THEN | |
26937 | WRITE(LO,'(1X,A,2E12.3)') | |
26938 | & 'PHO_HARZSP: ZMAX<ZMIN (ZMAX,ZMIN)',ZMAX,ZMIN | |
26939 | CALL PHO_PREVNT(-1) | |
26940 | ZZ = 0.D0 | |
26941 | RETURN | |
26942 | ENDIF | |
26943 | C | |
26944 | IF(IFLB.EQ.0) THEN | |
26945 | IF(IFLA.EQ.0) THEN | |
26946 | C g --> g g | |
26947 | C1 = ZMAX/ZMIN*(1.D0-ZMIN)/(1.D0-ZMAX) | |
26948 | C2 = (1.D0-ZMIN)/ZMIN | |
26949 | 100 CONTINUE | |
26950 | ZZ = 1.D0/(1.D0+C2/C1**DT_RNDM(ZMIN)) | |
26951 | IF(((1.D0-ZZ*(1.D0-ZZ))**2).LT.DT_RNDM(ZMAX)) GOTO 100 | |
26952 | ELSE IF(ABS(IFLA).LE.NFSH) THEN | |
26953 | C q --> q g | |
26954 | C1 = ZMAX/ZMIN | |
26955 | 200 CONTINUE | |
26956 | ZZ = ZMIN*C1**DT_RNDM(ZMIN) | |
26957 | IF((0.5D0*(1.D0+(1.D0-ZZ)**2)).LT.DT_RNDM(ZMAX)) GOTO 200 | |
26958 | ELSE | |
26959 | GOTO 900 | |
26960 | ENDIF | |
26961 | ELSE IF(ABS(IFLB).LE.NFSH) THEN | |
26962 | IF(IFLA.EQ.0) THEN | |
26963 | C g --> q qb | |
26964 | C1 = ZMAX-ZMIN | |
26965 | 300 CONTINUE | |
26966 | ZZ = ZMIN+C1*DT_RNDM(ZMIN) | |
26967 | IF((2.D0*ZZ*(ZZ-1.D0)+1.D0).LT.DT_RNDM(ZMAX)) GOTO 300 | |
26968 | ELSE IF(ABS(IFLA).LE.NFSH) THEN | |
26969 | C q --> g q | |
26970 | C1 = (1.D0-ZMAX)/(1.D0-ZMIN) | |
26971 | C2 = 1.D0-ZMIN | |
26972 | 400 CONTINUE | |
26973 | ZZ = 1.D0-C2*C1**DT_RNDM(ZMIN) | |
26974 | IF(0.5D0*(1.D0+ZZ**2).LT.DT_RNDM(ZMAX)) GOTO 400 | |
26975 | ELSE | |
26976 | GOTO 900 | |
26977 | ENDIF | |
26978 | ELSE | |
26979 | GOTO 900 | |
26980 | ENDIF | |
26981 | C debug output | |
26982 | IF(IDEB(80).GE.20) WRITE(LO,'(1X,A,2I3,3E11.3)') | |
26983 | & 'PHO_HARZSP: IFLA,IFLB,ZZ,ZMIN,ZMAX', | |
26984 | & IFLA,IFLB,ZZ,ZMIN,ZMAX | |
26985 | RETURN | |
26986 | ||
26987 | 900 CONTINUE | |
26988 | WRITE(LO,'(/1X,A,2I7)') 'PHO_HARZSP:ERROR: invalid flavours A,B', | |
26989 | & IFLA,IFLB | |
26990 | CALL PHO_ABORT | |
26991 | ||
26992 | END | |
26993 | ||
26994 | *$ CREATE PHO_ALPHAE.FOR | |
26995 | *COPY PHO_ALPHAE | |
26996 | CDECK ID>, PHO_ALPHAE | |
26997 | DOUBLE PRECISION FUNCTION PHO_ALPHAE(Q2) | |
26998 | C********************************************************************** | |
26999 | C | |
27000 | C calculation of ALPHA_em | |
27001 | C | |
27002 | C input: Q2 scale in GeV**2 | |
27003 | C | |
27004 | C********************************************************************** | |
27005 | IMPLICIT NONE | |
27006 | SAVE | |
27007 | ||
27008 | DOUBLE PRECISION Q2 | |
27009 | ||
27010 | C input/output channels | |
27011 | INTEGER LI,LO | |
27012 | COMMON /POINOU/ LI,LO | |
27013 | C model switches and parameters | |
27014 | CHARACTER*8 MDLNA | |
27015 | INTEGER ISWMDL,IPAMDL | |
27016 | DOUBLE PRECISION PARMDL | |
27017 | COMMON /POMDLS/ MDLNA(50),ISWMDL(50),PARMDL(400),IPAMDL(400) | |
27018 | ||
27019 | DOUBLE PRECISION PYALEM | |
27020 | ||
27021 | pho_alphae = 1.D0/137.D0 | |
27022 | ||
27023 | if(ipamdl(120).eq.1) then | |
27024 | pho_alphae = PYALEM(Q2) | |
27025 | endif | |
27026 | ||
27027 | END | |
27028 | ||
27029 | *$ CREATE PHO_ALPHAS.FOR | |
27030 | *COPY PHO_ALPHAS | |
27031 | CDECK ID>, PHO_ALPHAS | |
27032 | DOUBLE PRECISION FUNCTION PHO_ALPHAS(Q2,IMODE) | |
27033 | C********************************************************************** | |
27034 | C | |
27035 | C calculation of ALPHA_S | |
27036 | C | |
27037 | C input: IMODE = 1 lambda_QCD**2 for PDF 1 evolution | |
27038 | C 2 lambda_QCD**2 for PDF 2 evolution | |
27039 | C 3 lambda_QCD**2 for hard scattering | |
27040 | C Q2 scale in GeV**2 | |
27041 | C | |
27042 | C initialization needed: | |
27043 | C IMODE = 0 lambda values taken from PDF table | |
27044 | C -1 given Q2 is 4-flavour lambda 1 | |
27045 | C -2 given Q2 is 4-flavour lambda 2 | |
27046 | C -3 given Q2 is 4-flavour lambda 3 | |
27047 | C | |
27048 | C | |
27049 | C********************************************************************** | |
27050 | IMPLICIT NONE | |
27051 | SAVE | |
27052 | ||
27053 | DOUBLE PRECISION Q2 | |
27054 | INTEGER IMODE | |
27055 | ||
27056 | C input/output channels | |
27057 | INTEGER LI,LO | |
27058 | COMMON /POINOU/ LI,LO | |
27059 | C model switches and parameters | |
27060 | CHARACTER*8 MDLNA | |
27061 | INTEGER ISWMDL,IPAMDL | |
27062 | DOUBLE PRECISION PARMDL | |
27063 | COMMON /POMDLS/ MDLNA(50),ISWMDL(50),PARMDL(400),IPAMDL(400) | |
27064 | C hard scattering parameters used for most recent hard interaction | |
27065 | INTEGER NFbeta,NF | |
27066 | DOUBLE PRECISION ALQCD2,BQCD | |
27067 | COMMON /POHAPA/ ALQCD2(3,4),BQCD(4),NFbeta,NF | |
27068 | C currently activated parton density parametrizations | |
27069 | CHARACTER*8 PDFNAM | |
27070 | INTEGER IPARID,IPAVA,ITYPE,IGRP,ISET,IEXT,NPAOLD | |
27071 | DOUBLE PRECISION PDFLAM,PDFQ2M | |
27072 | COMMON /POPPDF/ PDFLAM(2),PDFQ2M(2),PDFNAM(2),IPARID(2), | |
27073 | & IPAVA(2),ITYPE(2),IGRP(2),ISET(2),IEXT(2),NPAOLD | |
27074 | ||
27075 | INTEGER I | |
27076 | ||
27077 | PHO_ALPHAS = 0.D0 | |
27078 | ||
27079 | IF(IMODE.GT.0) THEN | |
27080 | ||
27081 | IF(Q2.LT.PARMDL(148)) THEN | |
27082 | NFbeta = 1 | |
27083 | ELSE IF(Q2.LT.PARMDL(149)) THEN | |
27084 | NFbeta = 2 | |
27085 | ELSE IF(Q2.LT.PARMDL(150)) THEN | |
27086 | NFbeta = 3 | |
27087 | ELSE | |
27088 | NFbeta = 4 | |
27089 | ENDIF | |
27090 | ||
27091 | PHO_ALPHAS = BQCD(NFbeta)/LOG(Q2/ALQCD2(IMODE,NFbeta)) | |
27092 | NFbeta = NFbeta+2 | |
27093 | ||
27094 | ELSE IF(IMODE.EQ.0) THEN | |
27095 | ||
27096 | DO I=1,3 | |
27097 | if(I.EQ.3) then | |
27098 | ALQCD2(I,2) = PDFLAM(1)*PDFLAM(2) | |
27099 | else | |
27100 | ALQCD2(I,2) = PDFLAM(I)*PDFLAM(I) | |
27101 | endif | |
27102 | ALQCD2(I,1) = PARMDL(148) | |
27103 | & *(ALQCD2(I,2)/PARMDL(148))**(BQCD(1)/BQCD(2)) | |
27104 | ALQCD2(I,3) = PARMDL(149) | |
27105 | & *(ALQCD2(I,2)/PARMDL(149))**(BQCD(3)/BQCD(2)) | |
27106 | ALQCD2(I,4) = PARMDL(150) | |
27107 | & *(ALQCD2(I,2)/PARMDL(150))**(BQCD(4)/BQCD(2)) | |
27108 | ||
27109 | ENDDO | |
27110 | ||
27111 | ELSE IF(IMODE.LT.0) THEN | |
27112 | ||
27113 | if(IMODE.eq.-4) then | |
27114 | I = 3 | |
27115 | ALQCD2(I,2) = SQRT(ALQCD2(1,2)*ALQCD2(2,2)) | |
27116 | else | |
27117 | I = -IMODE | |
27118 | ALQCD2(I,2) = Q2 | |
27119 | endif | |
27120 | ALQCD2(I,1) = PARMDL(148) | |
27121 | & *(ALQCD2(I,2)/PARMDL(148))**(BQCD(1)/BQCD(2)) | |
27122 | ALQCD2(I,3) = PARMDL(149) | |
27123 | & *(ALQCD2(I,2)/PARMDL(149))**(BQCD(3)/BQCD(2)) | |
27124 | ALQCD2(I,4) = PARMDL(150) | |
27125 | & *(ALQCD2(I,2)/PARMDL(150))**(BQCD(4)/BQCD(2)) | |
27126 | ||
27127 | ENDIF | |
27128 | ||
27129 | END | |
27130 | ||
27131 | *$ CREATE PHO_DFWRAP.FOR | |
27132 | *COPY PHO_DFWRAP | |
27133 | CDECK ID>, PHO_DFWRAP | |
27134 | SUBROUTINE PHO_DFWRAP(MODE,JM1,JM2) | |
27135 | C********************************************************************** | |
27136 | C | |
27137 | C wrapper for diffraction dissociation in hadron-nucleus and | |
27138 | C nucleus-nucleus collisions with DPMJET | |
27139 | C | |
27140 | C input: MODE 1: transformation into CMS | |
27141 | C 2: transformation into Lab | |
27142 | C JM1/2 indices of old mother particles | |
27143 | C JM1/2N indices of new mother particles | |
27144 | C | |
27145 | C********************************************************************** | |
27146 | IMPLICIT NONE | |
27147 | SAVE | |
27148 | ||
27149 | INTEGER MODE,JM1,JM2 | |
27150 | ||
27151 | C input/output channels | |
27152 | INTEGER LI,LO | |
27153 | COMMON /POINOU/ LI,LO | |
27154 | C event debugging information | |
27155 | INTEGER NMAXD | |
27156 | PARAMETER (NMAXD=100) | |
27157 | INTEGER IDEB,KSPOM,KHPOM,KSREG,KHDIR,KACCEP,KSTRG,KHTRG,KSLOO, | |
27158 | & KHLOO,KSDPO,KHDPO,KEVENT,KSOFT,KHARD | |
27159 | COMMON /PODEBG/ IDEB(NMAXD),KSPOM,KHPOM,KSREG,KHDIR,KACCEP,KSTRG, | |
27160 | & KHTRG,KSLOO,KHLOO,KSDPO,KHDPO,KEVENT,KSOFT,KHARD | |
27161 | C standard particle data interface | |
27162 | INTEGER NMXHEP | |
27163 | PARAMETER (NMXHEP=4000) | |
27164 | INTEGER NEVHEP,NHEP,ISTHEP,IDHEP,JMOHEP,JDAHEP | |
27165 | DOUBLE PRECISION PHEP,VHEP | |
27166 | COMMON /POEVT1/ NEVHEP,NHEP,ISTHEP(NMXHEP),IDHEP(NMXHEP), | |
27167 | & JMOHEP(2,NMXHEP),JDAHEP(2,NMXHEP),PHEP(5,NMXHEP), | |
27168 | & VHEP(4,NMXHEP) | |
27169 | C extension to standard particle data interface (PHOJET specific) | |
27170 | INTEGER IMPART,IPHIST,ICOLOR | |
27171 | COMMON /POEVT2/ IMPART(NMXHEP),IPHIST(2,NMXHEP),ICOLOR(2,NMXHEP) | |
27172 | C nucleon-nucleus / nucleus-nucleus interface to DPMJET | |
27173 | INTEGER IDEQP,IDEQB,IHFLD,IHFLS | |
27174 | DOUBLE PRECISION ECMN,PCMN,SECM,SPCM,XPSUB,XTSUB | |
27175 | COMMON /POHDFL/ ECMN,PCMN,SECM,SPCM,XPSUB,XTSUB, | |
27176 | & IDEQP(2),IDEQB(2),IHFLD(2,2),IHFLS(2) | |
27177 | ||
27178 | DOUBLE PRECISION GAMBED(4),P1(4),P2(4),P3(4),P4(4),XM1,XM2 | |
27179 | DOUBLE PRECISION SS,ECMD,PTOT1,CODD,SIDD,COFD,SIFD,ANORF | |
27180 | ||
27181 | INTEGER I,NHEPS,JM1S,JM2S,JM1N,JM2N,IREJ | |
27182 | ||
27183 | C transformation into CMS | |
27184 | ||
27185 | IF(MODE.EQ.1) THEN | |
27186 | ||
27187 | JM1S = JM1 | |
27188 | JM2S = JM2 | |
27189 | NHEPS = NHEP | |
27190 | ||
27191 | XM1 = PHEP(5,JM1) | |
27192 | XM2 = PHEP(5,JM2) | |
27193 | ||
27194 | C boost into CMS | |
27195 | P1(1) = PHEP(1,JM1)+PHEP(1,JM2) | |
27196 | P1(2) = PHEP(2,JM1)+PHEP(2,JM2) | |
27197 | P1(3) = PHEP(3,JM1)+PHEP(3,JM2) | |
27198 | P1(4) = PHEP(4,JM1)+PHEP(4,JM2) | |
27199 | SS = (P1(4)+P1(3))*(P1(4)-P1(3))-P1(1)**2-P1(2)**2 | |
27200 | ECMD = SQRT(SS) | |
27201 | DO 10 I=1,4 | |
27202 | GAMBED(I) = P1(I)/ECMD | |
27203 | 10 CONTINUE | |
27204 | CALL PHO_ALTRA(GAMBED(4),-GAMBED(1),-GAMBED(2),-GAMBED(3), | |
27205 | & PHEP(1,JM1),PHEP(2,JM1),PHEP(3,JM1), | |
27206 | & PHEP(4,JM1),PTOT1,P1(1),P1(2),P1(3),P1(4)) | |
27207 | C rotation angles | |
27208 | CODD = P1(3)/PTOT1 | |
27209 | SIDD = SQRT(P1(1)**2+P1(2)**2)/PTOT1 | |
27210 | COFD = 1.D0 | |
27211 | SIFD = 0.D0 | |
27212 | IF(PTOT1*SIDD.GT.1.D-5) THEN | |
27213 | COFD = P1(1)/(SIDD*PTOT1) | |
27214 | SIFD = P1(2)/(SIDD*PTOT1) | |
27215 | ANORF= SQRT(COFD*COFD+SIFD*SIFD) | |
27216 | COFD = COFD/ANORF | |
27217 | SIFD = SIFD/ANORF | |
27218 | ENDIF | |
27219 | ||
27220 | C initial particles in CMS | |
27221 | ||
27222 | P1(1) = 0.D0 | |
27223 | P1(2) = 0.D0 | |
27224 | P1(3) = ECMD/2.D0*XPSUB | |
27225 | P1(4) = P1(3) | |
27226 | ||
27227 | P2(1) = 0.D0 | |
27228 | P2(2) = 0.D0 | |
27229 | P2(3) = -ECMD/2.D0*XTSUB | |
27230 | P2(4) = -P2(3) | |
27231 | ||
27232 | CALL PHO_MSHELL(P1,P2,XM1,XM2,P3,P4,IREJ) | |
27233 | ||
27234 | CALL PHO_REGPAR(1,IDHEP(JM1),IMPART(JM1),JM1,JM2, | |
27235 | & P3(1),P3(2),P3(3),P3(4),IPHIST(1,JM1),IPHIST(2,JM1), | |
27236 | & ICOLOR(1,JM1),ICOLOR(2,JM1),JM1N,1) | |
27237 | ||
27238 | CALL PHO_REGPAR(1,IDHEP(JM2),IMPART(JM2),JM2,JM1, | |
27239 | & P4(1),P4(2),P4(3),P4(4),IPHIST(1,JM2),IPHIST(2,JM2), | |
27240 | & ICOLOR(1,JM2),ICOLOR(2,JM2),JM2N,1) | |
27241 | ||
27242 | JM1 = JM1N | |
27243 | JM2 = JM2N | |
27244 | ||
27245 | C transformation into lab. | |
27246 | ||
27247 | ELSE IF(MODE.EQ.2) THEN | |
27248 | ||
27249 | CALL PHO_LTRHEP(JM1,NHEP,CODD,SIDD,COFD,SIFD,GAMBED(4), | |
27250 | & GAMBED(1),GAMBED(2),GAMBED(3)) | |
27251 | ||
27252 | JM1 = JM1S | |
27253 | JM2 = JM2S | |
27254 | ||
27255 | C clean up after rejection | |
27256 | ||
27257 | ELSE IF(MODE.EQ.-2) THEN | |
27258 | ||
27259 | NHEP = NHEPS | |
27260 | ||
27261 | JM1 = JM1S | |
27262 | JM2 = JM2S | |
27263 | ||
27264 | ELSE | |
27265 | ||
27266 | WRITE(LO,'(1X,A,I6)') 'PHO_DFWRAP: invalid MODE parameter:',MODE | |
27267 | ||
27268 | ENDIF | |
27269 | ||
27270 | END | |
27271 | ||
27272 | *$ CREATE PHO_DIFDIS.FOR | |
27273 | *COPY PHO_DIFDIS | |
27274 | CDECK ID>, PHO_DIFDIS | |
27275 | SUBROUTINE PHO_DIFDIS(IDIF1,IDIF2,IMOTH1,IMOTH2,SPROB,IMODE, | |
27276 | & MSOFT,MHARD,IREJ) | |
27277 | C*********************************************************************** | |
27278 | C | |
27279 | C sampling of diffractive events of different kinds, | |
27280 | C (produced particles stored in /POEVT1/) | |
27281 | C | |
27282 | C input: IDIF1/2 diffractive process particle 1/2 | |
27283 | C 0 elastic/quasi-elastic scattering | |
27284 | C 1 diffraction dissociation | |
27285 | C IMOTH1/2 index of mother particles in /POEVT1/ | |
27286 | C SPROB suppression factor (survival probability) for | |
27287 | C resolved diffraction dissociation | |
27288 | C IMODE mode of operation | |
27289 | C 0 sampling of diffractive cut | |
27290 | C 1 sampling of enhanced cut | |
27291 | C 2 sampling of diffractive cut without | |
27292 | C scattering (needed for double-pomeron) | |
27293 | C -1 initialization | |
27294 | C -2 output of statistics | |
27295 | C | |
27296 | C output: MSOFT number of generated soft strings | |
27297 | C MHARD number of generated hard strings | |
27298 | C IDIF1/2 diffraction label for particle 1/2 in /PROCES/ | |
27299 | C 0 quasi elastic scattering | |
27300 | C 1 low-mass diffractive dissociation | |
27301 | C 2 soft high-mass diffractive dissociation | |
27302 | C 3 hard resolved diffractive dissociation | |
27303 | C 4 hard direct diffractive dissociation | |
27304 | C IREJ rejection label | |
27305 | C 0 successful generation of partons | |
27306 | C 1 failure | |
27307 | C | |
27308 | C*********************************************************************** | |
27309 | IMPLICIT DOUBLE PRECISION (A-H,O-Z) | |
27310 | SAVE | |
27311 | ||
27312 | PARAMETER ( EPS = 1.D-7, | |
27313 | & DEPS = 1.D-10) | |
27314 | ||
27315 | C input/output channels | |
27316 | INTEGER LI,LO | |
27317 | COMMON /POINOU/ LI,LO | |
27318 | C event debugging information | |
27319 | INTEGER NMAXD | |
27320 | PARAMETER (NMAXD=100) | |
27321 | INTEGER IDEB,KSPOM,KHPOM,KSREG,KHDIR,KACCEP,KSTRG,KHTRG,KSLOO, | |
27322 | & KHLOO,KSDPO,KHDPO,KEVENT,KSOFT,KHARD | |
27323 | COMMON /PODEBG/ IDEB(NMAXD),KSPOM,KHPOM,KSREG,KHDIR,KACCEP,KSTRG, | |
27324 | & KHTRG,KSLOO,KHLOO,KSDPO,KHDPO,KEVENT,KSOFT,KHARD | |
27325 | C general process information | |
27326 | INTEGER IPROCE,IDNODF,IDIFR1,IDIFR2,IDDPOM,IPRON | |
27327 | COMMON /POPRCS/ IPROCE,IDNODF,IDIFR1,IDIFR2,IDDPOM,IPRON(15,4) | |
27328 | C internal rejection counters | |
27329 | INTEGER NMXJ | |
27330 | PARAMETER (NMXJ=60) | |
27331 | CHARACTER*10 REJTIT | |
27332 | INTEGER IFAIL | |
27333 | COMMON /POLOOP/ IFAIL(NMXJ),REJTIT(NMXJ) | |
27334 | C global event kinematics and particle IDs | |
27335 | INTEGER IFPAP,IFPAB | |
27336 | DOUBLE PRECISION ECM,PCM,PMASS,PVIRT | |
27337 | COMMON /POGCMS/ ECM,PCM,PMASS(2),PVIRT(2),IFPAP(2),IFPAB(2) | |
27338 | C c.m. kinematics of diffraction | |
27339 | INTEGER NPOSD | |
27340 | DOUBLE PRECISION ECMD,PCMD,PMASSD,PVIRTD,GAMBED, | |
27341 | & SIDD,CODD,SIFD,COFD,PDCMS | |
27342 | COMMON /PODCMS/ ECMD,PCMD,PMASSD(2),PVIRTD(2),GAMBED(4), | |
27343 | & SIDD,CODD,SIFD,COFD,PDCMS(4,2),NPOSD(2) | |
27344 | C obsolete cut-off information | |
27345 | DOUBLE PRECISION PTCUT,PTANO,FPS,FPH,PSOMIN,XSOMIN | |
27346 | COMMON /POCUT1/ PTCUT(4),PTANO(4),FPS(4),FPH(4),PSOMIN,XSOMIN | |
27347 | C some constants | |
27348 | DOUBLE PRECISION PI,PI2,PI4,GEV2MB,Q_ch,Q_ch2,Q_ch4 | |
27349 | COMMON /POCONS/ PI,PI2,PI4,GEV2MB, | |
27350 | & Q_ch(-6:6),Q_ch2(-6:6),Q_ch4(-6:6) | |
27351 | C model switches and parameters | |
27352 | CHARACTER*8 MDLNA | |
27353 | INTEGER ISWMDL,IPAMDL | |
27354 | DOUBLE PRECISION PARMDL | |
27355 | COMMON /POMDLS/ MDLNA(50),ISWMDL(50),PARMDL(400),IPAMDL(400) | |
27356 | C Reggeon phenomenology parameters | |
27357 | DOUBLE PRECISION ALPOM,ALPOMP,GP,B0POM,ALREG,ALREGP,GR,B0REG, | |
27358 | & GPPP,GPPR,B0PPP,B0PPR,VDMFAC,VDMQ2F,B0HAR,AKFAC | |
27359 | COMMON /POPREG/ ALPOM,ALPOMP,GP(2),B0POM(2), | |
27360 | & ALREG,ALREGP,GR(2),B0REG(2), | |
27361 | & GPPP,GPPR,B0PPP,B0PPR, | |
27362 | & VDMFAC(4),VDMQ2F(4),B0HAR,AKFAC | |
27363 | C parameters of 2x2 channel model | |
27364 | DOUBLE PRECISION PHISUP,RMASS,VAR,AMPFAC,ELAFAC,VFAC | |
27365 | COMMON /PO2CHA/ PHISUP(2),RMASS(2),VAR,AMPFAC(4),ELAFAC(4),VFAC | |
27366 | C table of particle indices for recursive PHOJET calls | |
27367 | INTEGER MAXIPX | |
27368 | PARAMETER ( MAXIPX = 100 ) | |
27369 | INTEGER IPOPOS,IPORES,IPOIX1,IPOIX2,IPOIX3 | |
27370 | COMMON /PORECU/ IPOPOS(2,MAXIPX),IPORES(MAXIPX), | |
27371 | & IPOIX1,IPOIX2,IPOIX3 | |
27372 | C standard particle data interface | |
27373 | INTEGER NMXHEP | |
27374 | PARAMETER (NMXHEP=4000) | |
27375 | INTEGER NEVHEP,NHEP,ISTHEP,IDHEP,JMOHEP,JDAHEP | |
27376 | DOUBLE PRECISION PHEP,VHEP | |
27377 | COMMON /POEVT1/ NEVHEP,NHEP,ISTHEP(NMXHEP),IDHEP(NMXHEP), | |
27378 | & JMOHEP(2,NMXHEP),JDAHEP(2,NMXHEP),PHEP(5,NMXHEP), | |
27379 | & VHEP(4,NMXHEP) | |
27380 | C extension to standard particle data interface (PHOJET specific) | |
27381 | INTEGER IMPART,IPHIST,ICOLOR | |
27382 | COMMON /POEVT2/ IMPART(NMXHEP),IPHIST(2,NMXHEP),ICOLOR(2,NMXHEP) | |
27383 | C event weights and generated cross section | |
27384 | INTEGER IPOWGC,ISWCUT,IVWGHT | |
27385 | DOUBLE PRECISION SIGGEN,HSWGHT,HSWCUT,EVWGHT | |
27386 | COMMON /POWGHT/ SIGGEN(4),HSWGHT(0:10),HSWCUT(20),EVWGHT(0:10), | |
27387 | & IPOWGC(0:10),ISWCUT(20),IVWGHT(0:10) | |
27388 | ||
27389 | DOUBLE PRECISION P1,P2,XMASS,AMP,PP,PD1,PD2 | |
27390 | DIMENSION P1(5),P2(5),XMASS(2),AMP(2),PP(7,2),PD1(7),PD2(7) | |
27391 | DIMENSION IDPDG(2),IDBAM(2),IPAR(2),IPOSP(2,2),IRPDG(2),IVEC(2), | |
27392 | & IRBAM(2),IFL1P(2),IFL2P(2),ISAM(2),JSAM(2),KSAM(2), | |
27393 | & IDIR(2),IPROC(2) | |
27394 | ||
27395 | IF(IMODE.EQ.-1) THEN | |
27396 | C initialization | |
27397 | RETURN | |
27398 | ELSE IF(IMODE.EQ.-2) THEN | |
27399 | C output of statistics | |
27400 | RETURN | |
27401 | ENDIF | |
27402 | ||
27403 | IREJ = 0 | |
27404 | C mass cuts | |
27405 | PIMASS = 0.140D0 | |
27406 | C debug output | |
27407 | IF(IDEB(45).GE.10) THEN | |
27408 | WRITE(LO,'(1X,2A,/16X,7I6)') 'PHO_DIFDIS: (1) ', | |
27409 | & 'IDIF1,IDIF2,IMOTH1,IMOTH2,MSOFT,MHARD,IMODE', | |
27410 | & IDIF1,IDIF2,IMOTH1,IMOTH2,MSOFT,MHARD,IMODE | |
27411 | ENDIF | |
27412 | IPAR(1) = IDIF1 | |
27413 | IPAR(2) = IDIF2 | |
27414 | C save current status | |
27415 | MSOFT = 0 | |
27416 | MHARD = 0 | |
27417 | KHPOMS = KHPOM | |
27418 | KSPOMS = KSPOM | |
27419 | KSREGS = KSREG | |
27420 | KHDIRS = KHDIR | |
27421 | IPOIS1 = IPOIX1 | |
27422 | IPOIS2 = IPOIX2 | |
27423 | IPOIS3 = IPOIX3 | |
27424 | JDA11 = JDAHEP(1,IMOTH1) | |
27425 | JDA21 = JDAHEP(2,IMOTH1) | |
27426 | JDA12 = JDAHEP(1,IMOTH2) | |
27427 | JDA22 = JDAHEP(2,IMOTH2) | |
27428 | ISTH1 = ISTHEP(IMOTH1) | |
27429 | ISTH2 = ISTHEP(IMOTH2) | |
27430 | NHEPS = NHEP | |
27431 | C get mother data | |
27432 | NPOSD(1) = IMOTH1 | |
27433 | NPOSD(2) = IMOTH2 | |
27434 | DO 20 I=1,2 | |
27435 | IDPDG(I) = IDHEP(NPOSD(I)) | |
27436 | IDBAM(I) = IMPART(NPOSD(I)) | |
27437 | AMP(I) = PHO_PMASS(IDBAM(I),0) | |
27438 | IF(IDPDG(I).EQ.22) THEN | |
27439 | PMASSD(I) = 0.765D0 | |
27440 | PVIRTD(I) = PHEP(5,NPOSD(I))**2 | |
27441 | ELSE | |
27442 | PMASSD(I) = PHO_PMASS(IDBAM(I),0) | |
27443 | PVIRTD(I) = 0.D0 | |
27444 | ENDIF | |
27445 | 20 CONTINUE | |
27446 | C get CM system | |
27447 | P1(1) = PHEP(1,IMOTH1)+PHEP(1,IMOTH2) | |
27448 | P1(2) = PHEP(2,IMOTH1)+PHEP(2,IMOTH2) | |
27449 | P1(3) = PHEP(3,IMOTH1)+PHEP(3,IMOTH2) | |
27450 | P1(4) = PHEP(4,IMOTH1)+PHEP(4,IMOTH2) | |
27451 | SS = (P1(4)+P1(3))*(P1(4)-P1(3))-P1(1)**2-P1(2)**2 | |
27452 | ECMD = SQRT(SS) | |
27453 | IF(IDEB(45).GE.15) WRITE(LO,'(1X,A,E12.4)') | |
27454 | & 'PHO_DIFDIS: availabe energy',ECMD | |
27455 | C check total available energy | |
27456 | IF((AMP(1)+AMP(2)+0.1D0).GE.ECMD) THEN | |
27457 | IF(IDEB(45).GE.2) WRITE(LO,'(1X,2A,/5X,A,1P,3E11.3)') | |
27458 | & 'PHO_DIFDIS: ', | |
27459 | & 'not enough energy for inelastic diffraction', | |
27460 | & 'ECM, particle masses:',ECMD,AMP | |
27461 | IFAIL(7) = IFAIL(7)+1 | |
27462 | IREJ = 1 | |
27463 | RETURN | |
27464 | ENDIF | |
27465 | C boost into CMS | |
27466 | DO 10 I=1,4 | |
27467 | GAMBED(I) = P1(I)/ECMD | |
27468 | 10 CONTINUE | |
27469 | CALL PHO_ALTRA(GAMBED(4),-GAMBED(1),-GAMBED(2),-GAMBED(3), | |
27470 | & PHEP(1,IMOTH1),PHEP(2,IMOTH1),PHEP(3,IMOTH1), | |
27471 | & PHEP(4,IMOTH1),PTOT1,P1(1),P1(2),P1(3),P1(4)) | |
27472 | C rotation angles | |
27473 | CODD = P1(3)/PTOT1 | |
27474 | SIDD = SQRT(P1(1)**2+P1(2)**2)/PTOT1 | |
27475 | COFD = 1.D0 | |
27476 | SIFD = 0.D0 | |
27477 | IF(PTOT1*SIDD.GT.1.D-5) THEN | |
27478 | COFD = P1(1)/(SIDD*PTOT1) | |
27479 | SIFD = P1(2)/(SIDD*PTOT1) | |
27480 | ANORF= SQRT(COFD*COFD+SIFD*SIFD) | |
27481 | COFD = COFD/ANORF | |
27482 | SIFD = SIFD/ANORF | |
27483 | ENDIF | |
27484 | C initial particles in CMS | |
27485 | PDCMS(1,1) = 0.D0 | |
27486 | PDCMS(2,1) = 0.D0 | |
27487 | PDCMS(3,1) = PTOT1 | |
27488 | PDCMS(4,1) = P1(4) | |
27489 | PDCMS(1,2) = 0.D0 | |
27490 | PDCMS(2,2) = 0.D0 | |
27491 | PDCMS(3,2) = -PTOT1 | |
27492 | PDCMS(4,2) = ECMD-P1(4) | |
27493 | C get new CM momentum | |
27494 | AM12 = PMASSD(1)**2 | |
27495 | AM22 = PMASSD(2)**2 | |
27496 | PCMD = PHO_XLAM(SS,AM12,AM22)/(2.D0*ECMD) | |
27497 | ||
27498 | C coherence constraint (min/max diffractive mass allowed) | |
27499 | IF(IMODE.EQ.2) THEN | |
27500 | THRM1 = PARMDL(71)/SQRT(1-PARMDL(72)) | |
27501 | THRM1 = MAX(THRM1,PARMDL(70)*PARMDL(71)) | |
27502 | THRM2 = SQRT(1-PARMDL(72))*ECMD | |
27503 | THRM2 = MIN(THRM2,ECMD/PARMDL(70)) | |
27504 | ELSE | |
27505 | THRM1 = PARMDL(46) | |
27506 | THRM2 = PARMDL(45)*ECMD | |
27507 | C check kinematic limits | |
27508 | IF(THRM2.LE.(4.D0*PARMDL(162))) IPAR(1) = MIN(IPAR(1),1) | |
27509 | IF(THRM2.LE.(4.D0*PARMDL(163))) IPAR(2) = MIN(IPAR(2),1) | |
27510 | ENDIF | |
27511 | ||
27512 | C check energy vs. coherence constraints | |
27513 | IF(MAX(PARMDL(162),PMASSD(1)+THRM1).GE.THRM2) IPAR(1) = 0 | |
27514 | IF(MAX(PARMDL(163),PMASSD(2)+THRM1).GE.THRM2) IPAR(2) = 0 | |
27515 | ||
27516 | C no phase space available | |
27517 | IF(IPAR(1)+IPAR(2).EQ.0) THEN | |
27518 | IF(IDEB(45).GE.2) WRITE(LO,'(1X,2A,1P,E11.3,2(/5X,A,2E11.3))') | |
27519 | & 'PHO_DIFDIS: ', | |
27520 | & 'not enough phase space for ine. diffraction (Ecm)',ECMD, | |
27521 | & 'side 1: min. mass, upper mass limit:', | |
27522 | & MAX(PARMDL(162),PMASSD(1)+THRM1),THRM2, | |
27523 | & 'side 2: min. mass, upper mass limit:', | |
27524 | & MAX(PARMDL(163),PMASSD(2)+THRM1),THRM2 | |
27525 | IFAIL(7) = IFAIL(7)+1 | |
27526 | IREJ = 1 | |
27527 | RETURN | |
27528 | ENDIF | |
27529 | ||
27530 | ITRY = 0 | |
27531 | ITRYM = 10 | |
27532 | IPARS1 = IPAR(1) | |
27533 | IPARS2 = IPAR(2) | |
27534 | ||
27535 | C main rejection loop | |
27536 | C ------------------------------- | |
27537 | 50 CONTINUE | |
27538 | ITRY = ITRY+1 | |
27539 | IF(ITRY.GT.1) THEN | |
27540 | IFAIL(13) = IFAIL(13)+1 | |
27541 | IF(ITRY.GE.ITRYM) THEN | |
27542 | IF(IDEB(45).GE.2) WRITE(LO,'(1X,A,I10,2I3)') | |
27543 | & 'PHO_DIFDIS: rejection (KEVE,IPAR1/2) ',KEVENT,IPAR | |
27544 | IFAIL(7) = IFAIL(7)+1 | |
27545 | IREJ = 1 | |
27546 | RETURN | |
27547 | ENDIF | |
27548 | ENDIF | |
27549 | KSPOM = KSPOMS | |
27550 | KHPOM = KHPOMS | |
27551 | KHDIR = KHDIRS | |
27552 | KSREG = KSREGS | |
27553 | IPAR(1) = IPARS1 | |
27554 | IPAR(2) = IPARS2 | |
27555 | C reset mother-daugther relations | |
27556 | NHEP = NHEPS | |
27557 | JDAHEP(1,IMOTH1) = JDA11 | |
27558 | JDAHEP(2,IMOTH1) = JDA21 | |
27559 | JDAHEP(1,IMOTH2) = JDA12 | |
27560 | JDAHEP(2,IMOTH2) = JDA22 | |
27561 | ISTHEP(IMOTH1) = ISTH1 | |
27562 | ISTHEP(IMOTH2) = ISTH2 | |
27563 | IPOIX1 = IPOIS1 | |
27564 | IPOIX2 = IPOIS2 | |
27565 | IPOIX3 = IPOIS3 | |
27566 | C | |
27567 | NSLP = 0 | |
27568 | NCOR = 0 | |
27569 | 55 CONTINUE | |
27570 | ||
27571 | C calculation of kinematics | |
27572 | DO 100 I=1,2 | |
27573 | C sampling of masses | |
27574 | IRPDG(I) = 0 | |
27575 | IRBAM(I) = 0 | |
27576 | IFL1P(I) = IDPDG(I) | |
27577 | IFL2P(I) = IDBAM(I) | |
27578 | IVEC(I) = 0 | |
27579 | IDIR(I) = 0 | |
27580 | ISAM(I) = 0 | |
27581 | JSAM(I) = 0 | |
27582 | KSAM(I) = 0 | |
27583 | IF(IPAR(I).EQ.0) THEN | |
27584 | C vector meson dominance assumed | |
27585 | XMASS(I) = AMP(I) | |
27586 | CALL PHO_VECRES(IVEC(I),XMASS(I),IFL1P(I),IFL2P(I)) | |
27587 | C diffraction dissociation | |
27588 | ELSE IF(IPAR(I).EQ.1) THEN | |
27589 | XMMIN = MAX(PARMDL(161+I),PMASSD(I)+THRM1) | |
27590 | PREF2 = PMASSD(I)**2 | |
27591 | XMASS(I) = PHO_DFMASS(XMMIN,THRM2,PREF2,PVIRTD(I),ISWMDL(22)) | |
27592 | ELSE | |
27593 | WRITE(LO,'(/1X,A,2I3)') | |
27594 | & 'PHO_DIFDIS:ERROR:invalid IPAR1,IPAR2',IPAR(1),IPAR(2) | |
27595 | CALL PHO_ABORT | |
27596 | ENDIF | |
27597 | 100 CONTINUE | |
27598 | ||
27599 | C sampling of momentum transfer | |
27600 | CALL PHO_DIFSLP(IPAR(1),IPAR(2),IVEC(1),IVEC(2),XMASS(1),XMASS(2), | |
27601 | & THRM2,TT,SLWGHT,IREJ) | |
27602 | IF(IREJ.NE.0) THEN | |
27603 | NSLP=NSLP+1 | |
27604 | IF(NSLP.LT.100) GOTO 55 | |
27605 | WRITE(LO,'(1X,2A,/10X,2I3,2E12.3)') 'PHO_DIFDIS: ', | |
27606 | & 'too many slope rejections:IPAR1,IPAR2,M1,M2',IPAR,XMASS | |
27607 | IREJ = 5 | |
27608 | RETURN | |
27609 | ENDIF | |
27610 | ||
27611 | C correct for t-M^2 correlation in diffraction | |
27612 | IF(DT_RNDM(TT).GT.SLWGHT) THEN | |
27613 | NCOR=NCOR+1 | |
27614 | IF(NCOR.LT.100) GOTO 55 | |
27615 | WRITE(LO,'(1X,2A,I10)') 'PHO_DIFDIS: ', | |
27616 | & 'too many rejections due to t-M**2 correlation (EVE)',KEVENT | |
27617 | IREJ = 5 | |
27618 | RETURN | |
27619 | ENDIF | |
27620 | ||
27621 | C debug output | |
27622 | IF(IDEB(45).GE.5) THEN | |
27623 | WRITE(LO,'(1X,A,/5X,2I3,3E12.3)') | |
27624 | & 'PHO_DIFDIS: IPAR1,IPAR2,XMASS1,XMASS2,TT',IPAR,XMASS,TT | |
27625 | ENDIF | |
27626 | C not double pomeron scattering | |
27627 | IF(IMODE.NE.2) THEN | |
27628 | C sample diffractive interaction processes | |
27629 | DO 120 I=1,2 | |
27630 | IF(IPAR(I).NE.0) THEN | |
27631 | C find particle combination | |
27632 | IF(IDPDG(I).EQ.IFPAP(1)) THEN | |
27633 | IP = 2 | |
27634 | ELSE IF(IDPDG(I).EQ.IFPAP(2)) THEN | |
27635 | IP = 3 | |
27636 | ELSE IF(IDPDG(I).EQ.990) THEN | |
27637 | IP = 4 | |
27638 | ELSE | |
27639 | IP = I+1 | |
27640 | ENDIF | |
27641 | C sample dissociation process | |
27642 | CALL PHO_DIFPRO(IP,ISWMDL(16),IDPDG(I),990,XMASS(I), | |
27643 | & PVIRTD(I),0.D0,SPROB,IPROC(I),ISAM(I),JSAM(I), | |
27644 | & KSAM(I),IDIR(I)) | |
27645 | IF((IPROC(I).EQ.1).OR.(IPROC(I).EQ.8)) THEN | |
27646 | C store process label | |
27647 | IF(IDIR(I).GT.0) THEN | |
27648 | IPAR(I) = 4 | |
27649 | ELSE IF(KSAM(I).GT.0) THEN | |
27650 | IPAR(I) = 3 | |
27651 | ELSE IF(ISAM(I).GT.0) THEN | |
27652 | IPAR(I) = 2 | |
27653 | ELSE | |
27654 | IPAR(I) = 1 | |
27655 | C mass fine correction | |
27656 | CALL PHO_MASSAD(IDPDG(I),IFL1P(I),IFL2P(I),PMASSD(I), | |
27657 | & XMASS(I),XMNEW,IRPDG(I),IRBAM(I)) | |
27658 | XMASS(I) = XMNEW | |
27659 | ENDIF | |
27660 | ELSE | |
27661 | C diffractive pomeron-hadron interaction | |
27662 | IPAR(I) = 10+IPROC(I) | |
27663 | ENDIF | |
27664 | C debug output | |
27665 | IF(IDEB(45).GE.15) WRITE(LO,'(1X,A,/10X,I3,E12.4,5I3)') | |
27666 | & 'PHO_DIFDIS: IP,XMASS,IPROC,ISAM,JSAM,KSAM,IDIR', | |
27667 | & IP,XMASS(I),IPROC(I),ISAM(I),JSAM(I),KSAM(I),IDIR(I) | |
27668 | ENDIF | |
27669 | 120 CONTINUE | |
27670 | ENDIF | |
27671 | C actualize debug information | |
27672 | IF(IMODE.EQ.1) THEN | |
27673 | IDIFR1 = IPAR(1) | |
27674 | IDIFR2 = IPAR(2) | |
27675 | ENDIF | |
27676 | C calculate new momenta in CMS | |
27677 | CALL PHO_DIFKIN(XMASS(1),XMASS(2),TT,P1,P2,IREJ) | |
27678 | IF(IREJ.NE.0) GOTO 50 | |
27679 | DO 130 I=1,4 | |
27680 | PP(I,1) = P1(I) | |
27681 | PP(I,2) = P2(I) | |
27682 | 130 CONTINUE | |
27683 | ||
27684 | C comment line for diffraction | |
27685 | CALL PHO_REGPAR(30,IPROCE,IMODE,NPOSD(1),NPOSD(2),XMASS(1), | |
27686 | & XMASS(2),TT,ECMD,IPAR(1),IPAR(2),IDPDG(1),IDPDG(2),ICPOS,1) | |
27687 | C write diffractive strings/particles | |
27688 | DO 200 I=1,2 | |
27689 | I1 = I | |
27690 | I2 = 3-I1 | |
27691 | DO K=1,4 | |
27692 | PD1(K) = PP(K,I1) | |
27693 | PD2(K) = PP(K,I2) | |
27694 | ENDDO | |
27695 | PP(6,I1) = SIGN(PHEP(5,NPOSD(I1))**2,PHEP(5,NPOSD(I1))) | |
27696 | PP(7,I1) = TT | |
27697 | IGEN = IPHIST(2,NPOSD(I1)) | |
27698 | if(IGEN.eq.0) IGEN = -I1*10 | |
27699 | CALL PHO_DIFPAR(NPOSD(I1),NPOSD(I2),IGEN,IFL1P(I1),IFL2P(I1), | |
27700 | & IPAR(I1),PD1,PD2,IPOSP(1,I1),IPOSP(2,I1),IMODE,IREJ) | |
27701 | IF(IREJ.NE.0) THEN | |
27702 | IFAIL(7+I) = IFAIL(7+I)+1 | |
27703 | IF(IDEB(45).GE.3) WRITE(LO,'(1X,A,2I3,E11.3)') | |
27704 | & 'PHO_DIFDIS: rejection by PHO_DIFPAR (I,IPAR,XM)', | |
27705 | & I,IPAR(I),XMASS(I) | |
27706 | GOTO 50 | |
27707 | ENDIF | |
27708 | ICOLOR(I1,ICPOS) = IPOSP(1,I1) | |
27709 | 200 CONTINUE | |
27710 | C double-pomeron scattering? | |
27711 | IF(IMODE.EQ.2) GOTO 150 | |
27712 | ||
27713 | C diffractive final states | |
27714 | DO 300 I=1,2 | |
27715 | 110 CONTINUE | |
27716 | IF(IPAR(I).EQ.0) THEN | |
27717 | C vector meson production | |
27718 | IF(IDPDG(I).EQ.22) THEN | |
27719 | IF(ISWMDL(21).GE.0) THEN | |
27720 | ISP = IPAMDL(3) | |
27721 | IF(ISWMDL(21).GE.1) ISP = IPAMDL(4) | |
27722 | CALL PHO_SDECAY(IPOSP(1,I),ISP,2) | |
27723 | ENDIF | |
27724 | C hadronic state of multi-pomeron coupling | |
27725 | ELSE IF(IDPDG(I).EQ.990) THEN | |
27726 | CALL PHO_SDECAY(IPOSP(1,I),0,2) | |
27727 | ENDIF | |
27728 | ELSE | |
27729 | IF((IPROC(I).EQ.1).OR.(IPROC(I).EQ.8)) THEN | |
27730 | IF(ISAM(I)+JSAM(I)+KSAM(I).EQ.0) JSAM(I) = 1 | |
27731 | IF(IDIR(I).GT.0) THEN | |
27732 | IPAR(I) = 4 | |
27733 | ELSE IF(KSAM(I).GT.0) THEN | |
27734 | IPAR(I) = 3 | |
27735 | ELSE IF(ISAM(I).GT.0) THEN | |
27736 | IPAR(I) = 2 | |
27737 | ELSE | |
27738 | IPAR(I) = 1 | |
27739 | ENDIF | |
27740 | ELSE | |
27741 | IPAR(I) = 10+IPROC(I) | |
27742 | ENDIF | |
27743 | IPHIST(I,ICPOS) = IPAR(I) | |
27744 | C update debug informantion | |
27745 | KSPOM = ISAM(I) | |
27746 | KSREG = JSAM(I) | |
27747 | KHPOM = KSAM(I) | |
27748 | KHDIR = IDIR(I) | |
27749 | IDIFR1 = IPAR(1) | |
27750 | IDIFR2 = IPAR(2) | |
27751 | IF((IRPDG(I).NE.0).AND.(ISWMDL(23).GT.0)) THEN | |
27752 | ||
27753 | C resonance decay, pi+pi- background | |
27754 | P1(1) = PHEP(1,IPOSP(1,I))+PHEP(1,IPOSP(2,I)) | |
27755 | P1(2) = PHEP(2,IPOSP(1,I))+PHEP(2,IPOSP(2,I)) | |
27756 | P1(3) = PHEP(3,IPOSP(1,I))+PHEP(3,IPOSP(2,I)) | |
27757 | P1(4) = PHEP(4,IPOSP(1,I))+PHEP(4,IPOSP(2,I)) | |
27758 | CALL PHO_REGPAR(1,IRPDG(I),IRBAM(I),IPOSP(1,I),IPOSP(2,I), | |
27759 | & P1(1),P1(2),P1(3),P1(4),0,2,0,0,IPOS,1) | |
27760 | C decay | |
27761 | IF(IDPDG(I).EQ.22) THEN | |
27762 | IPHIST(2,IPOS) = 3 | |
27763 | IF(ISWMDL(21).GE.0) THEN | |
27764 | ISP = IPAMDL(3) | |
27765 | IF(ISWMDL(21).GE.2) ISP = IPAMDL(4) | |
27766 | CALL PHO_SDECAY(IPOS,ISP,2) | |
27767 | ENDIF | |
27768 | ELSE | |
27769 | CALL PHO_SDECAY(IPOS,IPAMDL(3),2) | |
27770 | ENDIF | |
27771 | IREJ = 0 | |
27772 | ELSE | |
27773 | ||
27774 | C particle-pomeron scattering | |
27775 | IF(IPAR(I).LE.4) THEN | |
27776 | C non-diffractive particle-pomeron scattering | |
27777 | IGEN = IPHIST(2,NPOSD(I)) | |
27778 | if(IGEN.eq.0) then | |
27779 | if(I.eq.1) then | |
27780 | IGEN = 5 | |
27781 | else | |
27782 | IGEN = 6 | |
27783 | endif | |
27784 | endif | |
27785 | CALL PHO_STDPAR(IPOSP(1,I),IPOSP(2,I),IGEN, | |
27786 | & ISAM(I),JSAM(I),KSAM(I),IDIR(I),IREJ) | |
27787 | ELSE | |
27788 | C diffractive particle-pomeron scattering | |
27789 | IPOIX2 = IPOIX2+1 | |
27790 | IPORES(IPOIX2) = IPROC(I) | |
27791 | IPOPOS(1,IPOIX2) = IPOSP(1,I) | |
27792 | IPOPOS(2,IPOIX2) = IPOSP(2,I) | |
27793 | ENDIF | |
27794 | ENDIF | |
27795 | ENDIF | |
27796 | ||
27797 | C rejection? | |
27798 | IF(IREJ.NE.0) THEN | |
27799 | IFAIL(20+I) = IFAIL(20+I)+1 | |
27800 | IF(IPAR(I).GT.1) THEN | |
27801 | IF(IPAR(I).EQ.3) IFAIL(7+2*I) = IFAIL(7+2*I)+1 | |
27802 | IF(IPAR(I).EQ.4) IFAIL(8+2*I) = IFAIL(8+2*I)+1 | |
27803 | IF(IDIR(I).GT.0) THEN | |
27804 | IDIR(I) = 0 | |
27805 | ELSE IF(KSAM(I).GT.0) THEN | |
27806 | KSAM(I) = KSAM(I)-1 | |
27807 | ELSE IF(ISAM(I).GT.0) THEN | |
27808 | ISAM(I) = ISAM(I)-1 | |
27809 | ENDIF | |
27810 | GOTO 110 | |
27811 | ELSE | |
27812 | IF(IDEB(45).GE.2) WRITE(LO,'(1X,A,2I3,E11.3)') | |
27813 | & 'PHO_DIFDIS: rejection PHO_STDPAR (I,IPAR,XM)', | |
27814 | & I,IPAR(I),XMASS(I) | |
27815 | GOTO 50 | |
27816 | ENDIF | |
27817 | ENDIF | |
27818 | 300 CONTINUE | |
27819 | ||
27820 | IDIF1 = IPAR(1) | |
27821 | IDIF2 = IPAR(2) | |
27822 | C update debug information | |
27823 | KSPOM = KSPOMS+ISAM(1)+ISAM(2) | |
27824 | KSREG = KSREGS+JSAM(1)+JSAM(2) | |
27825 | KHPOM = KHPOMS+KSAM(1)+KSAM(2) | |
27826 | KHDIR = KHDIRS+IDIR(1)+IDIR(2) | |
27827 | ||
27828 | 150 CONTINUE | |
27829 | ||
27830 | C debug output | |
27831 | IF(IDEB(45).GE.10) THEN | |
27832 | WRITE(LO,'(1X,2A,/18X,7I6)') 'PHO_DIFDIS: (2) ', | |
27833 | & 'IPAR1,IPAR2,IMOTH1,IMOTH2,MSOFT,MHARD,IMODE', | |
27834 | & IPAR,NPOSD,MSOFT,MHARD,IMODE | |
27835 | ENDIF | |
27836 | IF(IDEB(45).GE.15) THEN | |
27837 | WRITE(LO,'(2(/1X,A))') 'PHO_DIFDIS: output of /POEVT1/', | |
27838 | & '------------------------------' | |
27839 | CALL PHO_PREVNT(0) | |
27840 | ENDIF | |
27841 | ||
27842 | END | |
27843 | ||
27844 | *$ CREATE PHO_DIFPRO.FOR | |
27845 | *COPY PHO_DIFPRO | |
27846 | CDECK ID>, PHO_DIFPRO | |
27847 | SUBROUTINE PHO_DIFPRO(IP,ICUT,ID1,ID2,XMASS,P2V1,P2V2,SPROB, | |
27848 | & IPROC,ISAM,JSAM,KSAM,IDIR) | |
27849 | C********************************************************************* | |
27850 | C | |
27851 | C sampling of diffraction dissociation process | |
27852 | C | |
27853 | C input: IP particle combination | |
27854 | C ICUT user imposed limitations | |
27855 | C ID1/2 PDG particle code of scattering particles | |
27856 | C XMASS diffractively produced mass (GeV) | |
27857 | C P2V1/2 virtuality of scattering particles (Gev**2) | |
27858 | C SPROB suppression factor for resolved single and | |
27859 | C double diffraction dissociation | |
27860 | C | |
27861 | C output: IRPOC process ID | |
27862 | C ISAM number of cut pomerons (soft) | |
27863 | C JSAM number of cut reggeons | |
27864 | C KSAM number of cut pomerons (hard) | |
27865 | C IDIR direct hard interaction | |
27866 | C | |
27867 | C********************************************************************* | |
27868 | IMPLICIT DOUBLE PRECISION (A-H,O-Z) | |
27869 | SAVE | |
27870 | ||
27871 | C input/output channels | |
27872 | INTEGER LI,LO | |
27873 | COMMON /POINOU/ LI,LO | |
27874 | C event debugging information | |
27875 | INTEGER NMAXD | |
27876 | PARAMETER (NMAXD=100) | |
27877 | INTEGER IDEB,KSPOM,KHPOM,KSREG,KHDIR,KACCEP,KSTRG,KHTRG,KSLOO, | |
27878 | & KHLOO,KSDPO,KHDPO,KEVENT,KSOFT,KHARD | |
27879 | COMMON /PODEBG/ IDEB(NMAXD),KSPOM,KHPOM,KSREG,KHDIR,KACCEP,KSTRG, | |
27880 | & KHTRG,KSLOO,KHLOO,KSDPO,KHDPO,KEVENT,KSOFT,KHARD | |
27881 | C general process information | |
27882 | INTEGER IPROCE,IDNODF,IDIFR1,IDIFR2,IDDPOM,IPRON | |
27883 | COMMON /POPRCS/ IPROCE,IDNODF,IDIFR1,IDIFR2,IDDPOM,IPRON(15,4) | |
27884 | C model switches and parameters | |
27885 | CHARACTER*8 MDLNA | |
27886 | INTEGER ISWMDL,IPAMDL | |
27887 | DOUBLE PRECISION PARMDL | |
27888 | COMMON /POMDLS/ MDLNA(50),ISWMDL(50),PARMDL(400),IPAMDL(400) | |
27889 | C energy-interpolation table | |
27890 | INTEGER IEETA2 | |
27891 | PARAMETER ( IEETA2 = 20 ) | |
27892 | INTEGER ISIMAX | |
27893 | DOUBLE PRECISION SIGTAB,SIGECM | |
27894 | COMMON /POTABL/ SIGTAB(4,80,IEETA2),SIGECM(4,IEETA2),ISIMAX | |
27895 | ||
27896 | ISAM = 0 | |
27897 | JSAM = 0 | |
27898 | KSAM = 0 | |
27899 | IDIR = 0 | |
27900 | ||
27901 | IF(XMASS.GT.3.D0) THEN | |
27902 | C rapidity gap survival probability | |
27903 | SPRO = 1.D0 | |
27904 | IF(ISWMDL(28).GE.1) SPRO = SPROB | |
27905 | C sample interaction | |
27906 | IPROC = 0 | |
27907 | CALL PHO_SAMPRO(IP,ID1,ID2,XMASS,P2V1,P2V2,SPRO,IPROC) | |
27908 | ELSE | |
27909 | IPROC = 1 | |
27910 | ENDIF | |
27911 | IF(IPROC.EQ.1) CALL PHO_SAMPRB(XMASS,IP,ISAM,JSAM,KSAM) | |
27912 | C non-diffractive hadron-pomeron interaction | |
27913 | IF((IPROC.EQ.1).OR.(IPROC.EQ.8)) THEN | |
27914 | C option for suppression of multiple interaction | |
27915 | IF(ICUT.EQ.0) THEN | |
27916 | IPROC = 1 | |
27917 | IF(ISAM+KSAM+IDIR.GT.0) THEN | |
27918 | ISAM = 1 | |
27919 | JSAM = 0 | |
27920 | ELSE | |
27921 | JSAM = 1 | |
27922 | ENDIF | |
27923 | KSAM = 0 | |
27924 | IDIR = 0 | |
27925 | ELSE IF(ICUT.EQ.1) THEN | |
27926 | IF(IDIR.GT.0) THEN | |
27927 | ELSE IF(KSAM.GT.0) THEN | |
27928 | KSAM = 1 | |
27929 | ISAM = 0 | |
27930 | JSAM = 0 | |
27931 | ELSE IF(ISAM.GT.0) THEN | |
27932 | ISAM = 1 | |
27933 | JSAM = 0 | |
27934 | ELSE | |
27935 | JSAM = 1 | |
27936 | ENDIF | |
27937 | ELSE IF(ICUT.EQ.2) THEN | |
27938 | KSAM = MIN(KSAM,1) | |
27939 | ELSE IF(ICUT.EQ.3) THEN | |
27940 | ISAM = MIN(ISAM,1) | |
27941 | ENDIF | |
27942 | ENDIF | |
27943 | END | |
27944 | ||
27945 | *$ CREATE PHO_DIFPAR.FOR | |
27946 | *COPY PHO_DIFPAR | |
27947 | CDECK ID>, PHO_DIFPAR | |
27948 | SUBROUTINE PHO_DIFPAR(IMOTH1,IMOTH2,IGENM,IFL1,IFL2,IPAR,P1,P2, | |
27949 | & IPOSH1,IPOSH2,IMODE,IREJ) | |
27950 | C*********************************************************************** | |
27951 | C | |
27952 | C perform string construction for diffraction dissociation | |
27953 | C | |
27954 | C input: IMOTH1,2 index of mother particles in POEVT1 | |
27955 | C IGENM production process of mother particles | |
27956 | C IFL1,IFL2 particle numbers | |
27957 | C (IDPDG,IDBAM for quasi-elas. hadron) | |
27958 | C IPAR 0 quasi-elasic scattering | |
27959 | C 1 single string configuration | |
27960 | C 2 two string configuration | |
27961 | C P1 massive 4 momentum of first | |
27962 | C P1(6) virtuality/squ.mass of particle (GeV**2) | |
27963 | C P1(7) virtuality of Pomeron (neg, GeV**2) | |
27964 | C P2 massive 4 momentum of second particle | |
27965 | C IMODE 1 diffraction dissociation | |
27966 | C 2 double-pomeron scattering | |
27967 | C | |
27968 | C output: IPOSH1,2 index of the particles in /POEVT1/ | |
27969 | C IREJ 0 successful string construction | |
27970 | C 1 no string construction possible | |
27971 | C | |
27972 | C*********************************************************************** | |
27973 | IMPLICIT DOUBLE PRECISION (A-H,O-Z) | |
27974 | SAVE | |
27975 | ||
27976 | DIMENSION P1(7),P2(7) | |
27977 | ||
27978 | PARAMETER ( EPS = 1.D-7, | |
27979 | & DEPS = 1.D-10) | |
27980 | ||
27981 | C input/output channels | |
27982 | INTEGER LI,LO | |
27983 | COMMON /POINOU/ LI,LO | |
27984 | C event debugging information | |
27985 | INTEGER NMAXD | |
27986 | PARAMETER (NMAXD=100) | |
27987 | INTEGER IDEB,KSPOM,KHPOM,KSREG,KHDIR,KACCEP,KSTRG,KHTRG,KSLOO, | |
27988 | & KHLOO,KSDPO,KHDPO,KEVENT,KSOFT,KHARD | |
27989 | COMMON /PODEBG/ IDEB(NMAXD),KSPOM,KHPOM,KSREG,KHDIR,KACCEP,KSTRG, | |
27990 | & KHTRG,KSLOO,KHLOO,KSDPO,KHDPO,KEVENT,KSOFT,KHARD | |
27991 | C internal rejection counters | |
27992 | INTEGER NMXJ | |
27993 | PARAMETER (NMXJ=60) | |
27994 | CHARACTER*10 REJTIT | |
27995 | INTEGER IFAIL | |
27996 | COMMON /POLOOP/ IFAIL(NMXJ),REJTIT(NMXJ) | |
27997 | C c.m. kinematics of diffraction | |
27998 | INTEGER NPOSD | |
27999 | DOUBLE PRECISION ECMD,PCMD,PMASSD,PVIRTD,GAMBED, | |
28000 | & SIDD,CODD,SIFD,COFD,PDCMS | |
28001 | COMMON /PODCMS/ ECMD,PCMD,PMASSD(2),PVIRTD(2),GAMBED(4), | |
28002 | & SIDD,CODD,SIFD,COFD,PDCMS(4,2),NPOSD(2) | |
28003 | C model switches and parameters | |
28004 | CHARACTER*8 MDLNA | |
28005 | INTEGER ISWMDL,IPAMDL | |
28006 | DOUBLE PRECISION PARMDL | |
28007 | COMMON /POMDLS/ MDLNA(50),ISWMDL(50),PARMDL(400),IPAMDL(400) | |
28008 | C some constants | |
28009 | DOUBLE PRECISION PI,PI2,PI4,GEV2MB,Q_ch,Q_ch2,Q_ch4 | |
28010 | COMMON /POCONS/ PI,PI2,PI4,GEV2MB, | |
28011 | & Q_ch(-6:6),Q_ch2(-6:6),Q_ch4(-6:6) | |
28012 | C standard particle data interface | |
28013 | INTEGER NMXHEP | |
28014 | PARAMETER (NMXHEP=4000) | |
28015 | INTEGER NEVHEP,NHEP,ISTHEP,IDHEP,JMOHEP,JDAHEP | |
28016 | DOUBLE PRECISION PHEP,VHEP | |
28017 | COMMON /POEVT1/ NEVHEP,NHEP,ISTHEP(NMXHEP),IDHEP(NMXHEP), | |
28018 | & JMOHEP(2,NMXHEP),JDAHEP(2,NMXHEP),PHEP(5,NMXHEP), | |
28019 | & VHEP(4,NMXHEP) | |
28020 | C extension to standard particle data interface (PHOJET specific) | |
28021 | INTEGER IMPART,IPHIST,ICOLOR | |
28022 | COMMON /POEVT2/ IMPART(NMXHEP),IPHIST(2,NMXHEP),ICOLOR(2,NMXHEP) | |
28023 | ||
28024 | DIMENSION PCH1(2,4) | |
28025 | data IC1 /0/ | |
28026 | data IC2 /0/ | |
28027 | ||
28028 | IREJ = 0 | |
28029 | ILTR1 = NHEP+1 | |
28030 | IGEN = IGENM | |
28031 | if(IGENM.le.-10) IGEN = 0 | |
28032 | ||
28033 | C elastic part | |
28034 | IF(IPAR.EQ.0) THEN | |
28035 | IF((IFL1.EQ.92).OR.(IFL1.EQ.91)) THEN | |
28036 | if(IGEN.eq.0) IGEN = 3 | |
28037 | C pi+/pi- isotropic background | |
28038 | CALL PHO_REGPAR(1,IFL1,IFL2,IMOTH1,IMOTH2, | |
28039 | & P1(1),P1(2),P1(3),P1(4),0,IGEN,0,0,IPOSH1,1) | |
28040 | CALL PHO_SDECAY(IPOSH1,0,-2) | |
28041 | ELSE | |
28042 | if(IGEN.eq.0) then | |
28043 | IGEN = 2 | |
28044 | if(IFL1.ne.IDHEP(IMOTH1)) IGEN = 3 | |
28045 | endif | |
28046 | C registration of particle or resonance | |
28047 | CALL PHO_REGPAR(1,IFL1,IFL2,IMOTH1,IMOTH2,P1(1),P1(2),P1(3), | |
28048 | & P1(4),0,IGEN,0,0,IPOSH1,1) | |
28049 | ENDIF | |
28050 | ||
28051 | C diffraction dissociation | |
28052 | ELSE IF((IPAR.GE.1).AND.(IPAR.LE.18)) THEN | |
28053 | C calculation of resulting particle momenta | |
28054 | IF(IMOTH1.EQ.NPOSD(1)) THEN | |
28055 | K = 2 | |
28056 | ELSE | |
28057 | K = 1 | |
28058 | ENDIF | |
28059 | DO 100 I=1,4 | |
28060 | PCH1(2,I) = PDCMS(I,K)-P2(I) | |
28061 | PCH1(1,I) = P1(I)-PCH1(2,I) | |
28062 | 100 CONTINUE | |
28063 | ||
28064 | C registration | |
28065 | if(IMODE.LT.2) then | |
28066 | if(IGEN.eq.0) IGEN = -IGENM/10+4 | |
28067 | CALL PHO_REGPAR(1,IFL1,IFL2,IMOTH1,IMOTH2,PCH1(1,1), | |
28068 | & PCH1(1,2),PCH1(1,3),PCH1(1,4),-1,IGEN,IC1,IC2,IPOSH1,1) | |
28069 | else | |
28070 | if(IGEN.eq.0) IGEN = 4 | |
28071 | endif | |
28072 | CALL PHO_REGPAR(1,990,0,IMOTH2,IMOTH1,PCH1(2,1),PCH1(2,2), | |
28073 | & PCH1(2,3),PCH1(2,4),-1,IGEN,IC1,IC2,IPOSH2,1) | |
28074 | ||
28075 | C invalid IPAR | |
28076 | ELSE | |
28077 | WRITE(LO,'(/1X,A,I6)') 'PHO_DIFPAR:ERROR: invalid IPAR:',IPAR | |
28078 | CALL PHO_ABORT | |
28079 | ENDIF | |
28080 | ||
28081 | C back transformation | |
28082 | CALL PHO_LTRHEP(ILTR1,NHEP,CODD,SIDD,COFD,SIFD,GAMBED(4), | |
28083 | & GAMBED(1),GAMBED(2),GAMBED(3)) | |
28084 | ||
28085 | END | |
28086 | ||
28087 | *$ CREATE PHO_QELAST.FOR | |
28088 | *COPY PHO_QELAST | |
28089 | CDECK ID>, PHO_QELAST | |
28090 | SUBROUTINE PHO_QELAST(IPROC,JM1,JM2,IREJ) | |
28091 | C********************************************************************** | |
28092 | C | |
28093 | C sampling of quasi elastic processes | |
28094 | C | |
28095 | C input: IPROC 2 purely elastic scattering | |
28096 | C IPROC 3 q-ela. omega/omega/phi/pi+pi- production | |
28097 | C IPROC 4 double pomeron scattering | |
28098 | C IPROC -1 initialization | |
28099 | C IPROC -2 output of statistics | |
28100 | C JM1/2 index of initial particle 1/2 | |
28101 | C | |
28102 | C output: initial and final particles in /POEVT1/ involving | |
28103 | C polarized resonances in /POEVT1/ and decay | |
28104 | C products | |
28105 | C | |
28106 | C IREJ 0 successful | |
28107 | C 1 failure | |
28108 | C 50 user rejection | |
28109 | C | |
28110 | C********************************************************************** | |
28111 | IMPLICIT DOUBLE PRECISION (A-H,O-Z) | |
28112 | SAVE | |
28113 | ||
28114 | PARAMETER ( NTAB = 20, | |
28115 | & EPS = 1.D-10, | |
28116 | & PIMASS = 0.13D0, | |
28117 | & DEPS = 1.D-10) | |
28118 | ||
28119 | C input/output channels | |
28120 | INTEGER LI,LO | |
28121 | COMMON /POINOU/ LI,LO | |
28122 | C event debugging information | |
28123 | INTEGER NMAXD | |
28124 | PARAMETER (NMAXD=100) | |
28125 | INTEGER IDEB,KSPOM,KHPOM,KSREG,KHDIR,KACCEP,KSTRG,KHTRG,KSLOO, | |
28126 | & KHLOO,KSDPO,KHDPO,KEVENT,KSOFT,KHARD | |
28127 | COMMON /PODEBG/ IDEB(NMAXD),KSPOM,KHPOM,KSREG,KHDIR,KACCEP,KSTRG, | |
28128 | & KHTRG,KSLOO,KHLOO,KSDPO,KHDPO,KEVENT,KSOFT,KHARD | |
28129 | C global event kinematics and particle IDs | |
28130 | INTEGER IFPAP,IFPAB | |
28131 | DOUBLE PRECISION ECM,PCM,PMASS,PVIRT | |
28132 | COMMON /POGCMS/ ECM,PCM,PMASS(2),PVIRT(2),IFPAP(2),IFPAB(2) | |
28133 | C c.m. kinematics of diffraction | |
28134 | INTEGER NPOSD | |
28135 | DOUBLE PRECISION ECMD,PCMD,PMASSD,PVIRTD,GAMBED, | |
28136 | & SIDD,CODD,SIFD,COFD,PDCMS | |
28137 | COMMON /PODCMS/ ECMD,PCMD,PMASSD(2),PVIRTD(2),GAMBED(4), | |
28138 | & SIDD,CODD,SIFD,COFD,PDCMS(4,2),NPOSD(2) | |
28139 | C model switches and parameters | |
28140 | CHARACTER*8 MDLNA | |
28141 | INTEGER ISWMDL,IPAMDL | |
28142 | DOUBLE PRECISION PARMDL | |
28143 | COMMON /POMDLS/ MDLNA(50),ISWMDL(50),PARMDL(400),IPAMDL(400) | |
28144 | C some constants | |
28145 | DOUBLE PRECISION PI,PI2,PI4,GEV2MB,Q_ch,Q_ch2,Q_ch4 | |
28146 | COMMON /POCONS/ PI,PI2,PI4,GEV2MB, | |
28147 | & Q_ch(-6:6),Q_ch2(-6:6),Q_ch4(-6:6) | |
28148 | C cross sections | |
28149 | INTEGER IPFIL,IFAFIL,IFBFIL | |
28150 | DOUBLE PRECISION SIGTOT,SIGELA,SIGVM,SIGINE,SIGNDF,SIGDIR, | |
28151 | & SIGLSD,SIGHSD,SIGLDD,SIGHDD,SIGCDF, | |
28152 | & SIGPOM,SIGREG,SIGHAR,SIGTR1,SIGTR2,SIGLOO, | |
28153 | & SIGDPO,SIG1SO,SIG1HA,SLOEL,SLOVM,SIGCOR, | |
28154 | & FSUP,FSUD,FSUH,ECMFIL,P2AFIL,P2BFIL | |
28155 | COMMON /POCSEC/ SIGTOT,SIGELA,SIGVM(0:4,0:4),SIGINE,SIGNDF,SIGDIR, | |
28156 | & SIGLSD(2),SIGHSD(2),SIGLDD,SIGHDD,SIGCDF(0:4), | |
28157 | & SIGPOM,SIGREG,SIGHAR,SIGTR1(2),SIGTR2(2),SIGLOO, | |
28158 | & SIGDPO(4),SIG1SO,SIG1HA,SLOEL,SLOVM(4,4),SIGCOR, | |
28159 | & FSUP(2),FSUD(2),FSUH(2),ECMFIL,P2AFIL,P2BFIL, | |
28160 | & IPFIL,IFAFIL,IFBFIL | |
28161 | C standard particle data interface | |
28162 | INTEGER NMXHEP | |
28163 | PARAMETER (NMXHEP=4000) | |
28164 | INTEGER NEVHEP,NHEP,ISTHEP,IDHEP,JMOHEP,JDAHEP | |
28165 | DOUBLE PRECISION PHEP,VHEP | |
28166 | COMMON /POEVT1/ NEVHEP,NHEP,ISTHEP(NMXHEP),IDHEP(NMXHEP), | |
28167 | & JMOHEP(2,NMXHEP),JDAHEP(2,NMXHEP),PHEP(5,NMXHEP), | |
28168 | & VHEP(4,NMXHEP) | |
28169 | C extension to standard particle data interface (PHOJET specific) | |
28170 | INTEGER IMPART,IPHIST,ICOLOR | |
28171 | COMMON /POEVT2/ IMPART(NMXHEP),IPHIST(2,NMXHEP),ICOLOR(2,NMXHEP) | |
28172 | ||
28173 | DOUBLE PRECISION P,PK1,PK2,PMI,RMASS | |
28174 | DIMENSION P(4,2),PK1(5),PK2(5),PMI(2),RMASS(2) | |
28175 | DIMENSION IFL(2),IDPRO(4) | |
28176 | character*15 pho_pname | |
28177 | CHARACTER*8 VMESA(0:4),VMESB(0:4) | |
28178 | DIMENSION ISAMVM(4,4) | |
28179 | DATA IDPRO / 113,223,333,92 / | |
28180 | DATA VMESA / 'vmeson ','rho ','omega ','phi ', | |
28181 | & 'pi+pi- ' / | |
28182 | DATA VMESB / 'vmeson ','rho ','omega ','phi ', | |
28183 | & 'pi+pi- ' / | |
28184 | ||
28185 | C sampling of elastic/quasi-elastic processes | |
28186 | IF((IPROC.EQ.2).OR.(IPROC.EQ.3)) THEN | |
28187 | IREJ = 0 | |
28188 | NPOSD(1) = JM1 | |
28189 | NPOSD(2) = JM2 | |
28190 | DO 55 I=1,2 | |
28191 | PMI(I) = PHEP(5,NPOSD(I)) | |
28192 | IF(PMI(I).LT.0.1D0) PMI(I) = 0.765D0 | |
28193 | 55 CONTINUE | |
28194 | C get CM system | |
28195 | PK1(1) = PHEP(1,JM1)+PHEP(1,JM2) | |
28196 | PK1(2) = PHEP(2,JM1)+PHEP(2,JM2) | |
28197 | PK1(3) = PHEP(3,JM1)+PHEP(3,JM2) | |
28198 | PK1(4) = PHEP(4,JM1)+PHEP(4,JM2) | |
28199 | SS = (PK1(4)+PK1(3))*(PK1(4)-PK1(3))-PK1(1)**2-PK1(2)**2 | |
28200 | ECMD = SQRT(SS) | |
28201 | ||
28202 | IF(ECMD.LE.PMI(1)+PMI(2)) THEN | |
28203 | IF(IDEB(34).GE.3) WRITE(LO,'(1X,A,I12,3E12.4)') | |
28204 | & 'PHO_QELAST: too small mass (EV,ECM,M1,M2)',KEVENT, | |
28205 | & ECMD,PMI | |
28206 | IREJ = 5 | |
28207 | RETURN | |
28208 | ENDIF | |
28209 | ||
28210 | DO 60 I=1,4 | |
28211 | GAMBED(I) = PK1(I)/ECMD | |
28212 | 60 CONTINUE | |
28213 | CALL PHO_ALTRA(GAMBED(4),-GAMBED(1),-GAMBED(2),-GAMBED(3), | |
28214 | & PHEP(1,NPOSD(1)),PHEP(2,NPOSD(1)),PHEP(3,NPOSD(1)), | |
28215 | & PHEP(4,NPOSD(1)),PTOT1,PK1(1),PK1(2),PK1(3),PK1(4)) | |
28216 | C rotation angles | |
28217 | CODD = PK1(3)/PTOT1 | |
28218 | SIDD = SQRT(PK1(1)**2+PK1(2)**2)/PTOT1 | |
28219 | COFD = 1.D0 | |
28220 | SIFD = 0.D0 | |
28221 | IF(PTOT1*SIDD.GT.1.D-5) THEN | |
28222 | COFD = PK1(1)/(SIDD*PTOT1) | |
28223 | SIFD = PK1(2)/(SIDD*PTOT1) | |
28224 | ANORF = SQRT(COFD*COFD+SIFD*SIFD) | |
28225 | COFD = COFD/ANORF | |
28226 | SIFD = SIFD/ANORF | |
28227 | ENDIF | |
28228 | C get CM momentum | |
28229 | AM12 = PMI(1)**2 | |
28230 | AM22 = PMI(2)**2 | |
28231 | PCMD = PHO_XLAM(SS,AM12,AM22)/(2.D0*ECMD) | |
28232 | ||
28233 | C production process of mother particles | |
28234 | IGEN = IPHIST(2,NPOSD(1)) | |
28235 | if(IGEN.eq.0) IGEN = IPROC | |
28236 | ||
28237 | ICALL = ICALL + 1 | |
28238 | C main rejection label | |
28239 | 50 CONTINUE | |
28240 | C determine process and final particles | |
28241 | IFL(1) = IDHEP(NPOSD(1)) | |
28242 | IFL(2) = IDHEP(NPOSD(2)) | |
28243 | IF(IPROC.EQ.3) THEN | |
28244 | ITRY = 0 | |
28245 | 100 CONTINUE | |
28246 | ITRY = ITRY+1 | |
28247 | IF(ITRY.GT.50) THEN | |
28248 | IF(IDEB(34).GE.3) WRITE(LO,'(1X,A,I12,I5,E12.4)') | |
28249 | & 'PHO_QELAST: mass rejection (EV,ITRY,ECM)',KEVENT, | |
28250 | & ITRY,ECMD | |
28251 | IREJ = 5 | |
28252 | RETURN | |
28253 | ENDIF | |
28254 | XI = DT_RNDM(PCMD)*SIGVM(0,0)-DEPS | |
28255 | DO 110 I=1,4 | |
28256 | DO 120 J=1,4 | |
28257 | XI = XI-SIGVM(I,J) | |
28258 | IF(XI.LE.0.D0) GOTO 130 | |
28259 | 120 CONTINUE | |
28260 | 110 CONTINUE | |
28261 | 130 CONTINUE | |
28262 | IF(IFL(1).EQ.22) IFL(1) = IDPRO(I) | |
28263 | IF(IFL(2).EQ.22) IFL(2) = IDPRO(J) | |
28264 | ISAMVM(I,J) = ISAMVM(I,J)+1 | |
28265 | ISAMQE = ISAMQE+1 | |
28266 | C sample new masses | |
28267 | CALL PHO_SAMASS(IFL(1),RMASS(1)) | |
28268 | CALL PHO_SAMASS(IFL(2),RMASS(2)) | |
28269 | IF(RMASS(1)+RMASS(2).GE.ECMD) GOTO 100 | |
28270 | ELSE IF(IPROC.EQ.2) THEN | |
28271 | I = 0 | |
28272 | J = 0 | |
28273 | ISAMEL = ISAMEL+1 | |
28274 | RMASS(1) = PHO_PMASS(NPOSD(1),2) | |
28275 | RMASS(2) = PHO_PMASS(NPOSD(2),2) | |
28276 | ELSE | |
28277 | WRITE(LO,'(/1X,A,I6)') 'PHO_QELAST:ERROR: invalid IPROC',IPROC | |
28278 | CALL PHO_ABORT | |
28279 | ENDIF | |
28280 | C sample momentum transfer | |
28281 | CALL PHO_DIFSLP(0,0,I,J,RMASS(1),RMASS(2),RMASS(1),TT, | |
28282 | & SLWGHT,IREJ) | |
28283 | IF(IDEB(34).GE.5) WRITE(LO,'(1X,A,2I6,I3,3E11.3)') | |
28284 | & 'PHO_QELAST: IF1,2,T,RM1,RM2',IFL,IPROC,TT,RMASS | |
28285 | C calculate new momenta | |
28286 | CALL PHO_DIFKIN(RMASS(1),RMASS(2),TT,PK1,PK2,IREJ) | |
28287 | IF(IREJ.NE.0) GOTO 50 | |
28288 | DO K=1,4 | |
28289 | P(K,1) = PK1(K) | |
28290 | P(K,2) = PK2(K) | |
28291 | ENDDO | |
28292 | C comment line for elastic/quasi-elastic scattering | |
28293 | CALL PHO_REGPAR(35,IPROC,0,NPOSD(1),NPOSD(2),RMASS(1),RMASS(2), | |
28294 | & TT,ECMD,IFL(1),IFL(2),IDHEP(NPOSD(1)),IDHEP(NPOSD(2)),ICPOS,1) | |
28295 | ||
28296 | I1 = NHEP+1 | |
28297 | C fill /POEVT1/ | |
28298 | DO 200 I=1,2 | |
28299 | K = 3-I | |
28300 | IF((IFL(I).EQ.92).OR.(IFL(I).EQ.91)) THEN | |
28301 | C pi+/pi- isotropic background | |
28302 | IGEN = 3 | |
28303 | CALL PHO_REGPAR(1,113,0,NPOSD(I),NPOSD(K),P(1,I),P(2,I), | |
28304 | & P(3,I),P(4,I),0,IGEN,0,0,IPOS,1) | |
28305 | ICOLOR(I,ICPOS) = IPOS | |
28306 | CALL PHO_SDECAY(IPOS,0,-2) | |
28307 | ELSE | |
28308 | C registration | |
28309 | IGEN = 2 | |
28310 | if(IFL(I).ne.IDHEP(NPOSD(I))) IGEN = 3 | |
28311 | CALL PHO_REGPAR(1,IFL(I),0,NPOSD(I),NPOSD(K),P(1,I),P(2,I), | |
28312 | & P(3,I),P(4,I),0,IGEN,0,0,IPOS,1) | |
28313 | ICOLOR(I,ICPOS) = IPOS | |
28314 | ENDIF | |
28315 | 200 CONTINUE | |
28316 | I2 = NHEP | |
28317 | C search for vector mesons | |
28318 | DO 300 I=I1,I2 | |
28319 | C decay according to polarization | |
28320 | IF((IDHEP(JMOHEP(1,I)).EQ.22).AND.(ISWMDL(21).GE.0)) THEN | |
28321 | ISP = IPAMDL(3) | |
28322 | IF(ISWMDL(21).GE.1) ISP = IPAMDL(4) | |
28323 | CALL PHO_SDECAY(I,ISP,2) | |
28324 | ENDIF | |
28325 | 300 CONTINUE | |
28326 | I2 = NHEP | |
28327 | C back transformation | |
28328 | CALL PHO_LTRHEP(I1,I2,CODD,SIDD,COFD,SIFD,GAMBED(4),GAMBED(1), | |
28329 | & GAMBED(2),GAMBED(3)) | |
28330 | ||
28331 | C initialization of tables | |
28332 | ELSE IF(IPROC.EQ.-1) THEN | |
28333 | DO 10 I=1,4 | |
28334 | DO 20 J=1,4 | |
28335 | ISAMVM(I,J) = 0 | |
28336 | 20 CONTINUE | |
28337 | 10 CONTINUE | |
28338 | ISAMEL = 0 | |
28339 | ISAMQE = 0 | |
28340 | IF(IFPAP(1).NE.22) VMESA(1) = PHO_PNAME(IFPAP(1),1) | |
28341 | IF(IFPAP(2).NE.22) VMESB(1) = PHO_PNAME(IFPAP(2),1) | |
28342 | CALL PHO_SAMASS(-1,RMASS(1)) | |
28343 | ICALL = 0 | |
28344 | ||
28345 | C output of statistics | |
28346 | ELSE IF(IPROC.EQ.-2) THEN | |
28347 | IF(ICALL.LT.10) RETURN | |
28348 | WRITE(LO,'(/,1X,A,I10/,1X,A)') | |
28349 | & 'PHO_QELAST: statistics of (quasi-)elastic processes',ICALL, | |
28350 | & '---------------------------------------------------' | |
28351 | WRITE(LO,'(1X,A,I10)') | |
28352 | & 'sampled elastic processes:',ISAMEL | |
28353 | WRITE(LO,'(1X,A,I10)') | |
28354 | & 'sampled quasi-elastic vectormeson production:',ISAMQE | |
28355 | WRITE(LO,'(15X,4(4X,A))') (VMESB(I),I=1,4) | |
28356 | DO 30 I=1,4 | |
28357 | WRITE(LO,'(5X,A,4I12)') VMESA(I),(ISAMVM(I,K),K=1,4) | |
28358 | 30 CONTINUE | |
28359 | CALL PHO_SAMASS(-2,RMASS(1)) | |
28360 | ELSE | |
28361 | WRITE(LO,'(/1X,2A,I3)') 'PHO_QELAST:ERROR: ', | |
28362 | & 'unknown process ID',IPROC | |
28363 | CALL PHO_ABORT | |
28364 | ENDIF | |
28365 | ||
28366 | END | |
28367 | ||
28368 | *$ CREATE PHO_CDIFF.FOR | |
28369 | *COPY PHO_CDIFF | |
28370 | CDECK ID>, PHO_CDIFF | |
28371 | SUBROUTINE PHO_CDIFF(IMOTH1,IMOTH2,MSOFT,MHARD,IMODE,IREJ) | |
28372 | C********************************************************************** | |
28373 | C | |
28374 | C preparation of /POEVT1/ for double-pomeron scattering | |
28375 | C | |
28376 | C input: IMOTH1/2 index of mother particles in /POEVT1/ | |
28377 | C | |
28378 | C IMODE 1 sampling of pomeron-pomeron scattering | |
28379 | C -1 initialization | |
28380 | C -2 output of statistics | |
28381 | C | |
28382 | C output: MSOFT number of generated soft strings | |
28383 | C MHARD number of generated hard strings | |
28384 | C IREJ 0 accepted | |
28385 | C 1 rejected | |
28386 | C 50 user rejection | |
28387 | C | |
28388 | C********************************************************************** | |
28389 | IMPLICIT DOUBLE PRECISION (A-H,O-Z) | |
28390 | SAVE | |
28391 | ||
28392 | PARAMETER ( EPS = 1.D-10, | |
28393 | & DEPS = 1.D-10) | |
28394 | ||
28395 | C input/output channels | |
28396 | INTEGER LI,LO | |
28397 | COMMON /POINOU/ LI,LO | |
28398 | C event debugging information | |
28399 | INTEGER NMAXD | |
28400 | PARAMETER (NMAXD=100) | |
28401 | INTEGER IDEB,KSPOM,KHPOM,KSREG,KHDIR,KACCEP,KSTRG,KHTRG,KSLOO, | |
28402 | & KHLOO,KSDPO,KHDPO,KEVENT,KSOFT,KHARD | |
28403 | COMMON /PODEBG/ IDEB(NMAXD),KSPOM,KHPOM,KSREG,KHDIR,KACCEP,KSTRG, | |
28404 | & KHTRG,KSLOO,KHLOO,KSDPO,KHDPO,KEVENT,KSOFT,KHARD | |
28405 | C internal rejection counters | |
28406 | INTEGER NMXJ | |
28407 | PARAMETER (NMXJ=60) | |
28408 | CHARACTER*10 REJTIT | |
28409 | INTEGER IFAIL | |
28410 | COMMON /POLOOP/ IFAIL(NMXJ),REJTIT(NMXJ) | |
28411 | C model switches and parameters | |
28412 | CHARACTER*8 MDLNA | |
28413 | INTEGER ISWMDL,IPAMDL | |
28414 | DOUBLE PRECISION PARMDL | |
28415 | COMMON /POMDLS/ MDLNA(50),ISWMDL(50),PARMDL(400),IPAMDL(400) | |
28416 | C general process information | |
28417 | INTEGER IPROCE,IDNODF,IDIFR1,IDIFR2,IDDPOM,IPRON | |
28418 | COMMON /POPRCS/ IPROCE,IDNODF,IDIFR1,IDIFR2,IDDPOM,IPRON(15,4) | |
28419 | C Reggeon phenomenology parameters | |
28420 | DOUBLE PRECISION ALPOM,ALPOMP,GP,B0POM,ALREG,ALREGP,GR,B0REG, | |
28421 | & GPPP,GPPR,B0PPP,B0PPR,VDMFAC,VDMQ2F,B0HAR,AKFAC | |
28422 | COMMON /POPREG/ ALPOM,ALPOMP,GP(2),B0POM(2), | |
28423 | & ALREG,ALREGP,GR(2),B0REG(2), | |
28424 | & GPPP,GPPR,B0PPP,B0PPR, | |
28425 | & VDMFAC(4),VDMQ2F(4),B0HAR,AKFAC | |
28426 | C parameters of 2x2 channel model | |
28427 | DOUBLE PRECISION PHISUP,RMASS,VAR,AMPFAC,ELAFAC,VFAC | |
28428 | COMMON /PO2CHA/ PHISUP(2),RMASS(2),VAR,AMPFAC(4),ELAFAC(4),VFAC | |
28429 | C some constants | |
28430 | DOUBLE PRECISION PI,PI2,PI4,GEV2MB,Q_ch,Q_ch2,Q_ch4 | |
28431 | COMMON /POCONS/ PI,PI2,PI4,GEV2MB, | |
28432 | & Q_ch(-6:6),Q_ch2(-6:6),Q_ch4(-6:6) | |
28433 | C energy-interpolation table | |
28434 | INTEGER IEETA2 | |
28435 | PARAMETER ( IEETA2 = 20 ) | |
28436 | INTEGER ISIMAX | |
28437 | DOUBLE PRECISION SIGTAB,SIGECM | |
28438 | COMMON /POTABL/ SIGTAB(4,80,IEETA2),SIGECM(4,IEETA2),ISIMAX | |
28439 | C table of particle indices for recursive PHOJET calls | |
28440 | INTEGER MAXIPX | |
28441 | PARAMETER ( MAXIPX = 100 ) | |
28442 | INTEGER IPOPOS,IPORES,IPOIX1,IPOIX2,IPOIX3 | |
28443 | COMMON /PORECU/ IPOPOS(2,MAXIPX),IPORES(MAXIPX), | |
28444 | & IPOIX1,IPOIX2,IPOIX3 | |
28445 | C standard particle data interface | |
28446 | INTEGER NMXHEP | |
28447 | PARAMETER (NMXHEP=4000) | |
28448 | INTEGER NEVHEP,NHEP,ISTHEP,IDHEP,JMOHEP,JDAHEP | |
28449 | DOUBLE PRECISION PHEP,VHEP | |
28450 | COMMON /POEVT1/ NEVHEP,NHEP,ISTHEP(NMXHEP),IDHEP(NMXHEP), | |
28451 | & JMOHEP(2,NMXHEP),JDAHEP(2,NMXHEP),PHEP(5,NMXHEP), | |
28452 | & VHEP(4,NMXHEP) | |
28453 | C extension to standard particle data interface (PHOJET specific) | |
28454 | INTEGER IMPART,IPHIST,ICOLOR | |
28455 | COMMON /POEVT2/ IMPART(NMXHEP),IPHIST(2,NMXHEP),ICOLOR(2,NMXHEP) | |
28456 | ||
28457 | DIMENSION PD(4) | |
28458 | ||
28459 | if(IMODE.ne.1) return | |
28460 | ||
28461 | IREJ = 0 | |
28462 | IP = 4 | |
28463 | C select first diffraction | |
28464 | IF(DT_RNDM(DUM).GT.0.5D0) THEN | |
28465 | IPAR1 = 1 | |
28466 | IPAR2 = 0 | |
28467 | ELSE | |
28468 | IPAR1 = 0 | |
28469 | IPAR2 = 1 | |
28470 | ENDIF | |
28471 | ITRY2 = 0 | |
28472 | ITRYM = 1000 | |
28473 | ||
28474 | C save current status | |
28475 | MSOFT = 0 | |
28476 | MHARD = 0 | |
28477 | KHPOMS = KHPOM | |
28478 | KSPOMS = KSPOM | |
28479 | KSREGS = KSREG | |
28480 | KHDIRS = KHDIR | |
28481 | IPOIS1 = IPOIX1 | |
28482 | IPOIS2 = IPOIX2 | |
28483 | IPOIS3 = IPOIX3 | |
28484 | JDA11 = JDAHEP(1,IMOTH1) | |
28485 | JDA21 = JDAHEP(2,IMOTH1) | |
28486 | JDA12 = JDAHEP(1,IMOTH2) | |
28487 | JDA22 = JDAHEP(2,IMOTH2) | |
28488 | ISTH1 = ISTHEP(IMOTH1) | |
28489 | ISTH2 = ISTHEP(IMOTH2) | |
28490 | NHEPS = NHEP | |
28491 | ||
28492 | C find mother particle production process | |
28493 | IGEN = IPHIST(2,IMOTH1) | |
28494 | if(IGEN.eq.0) IGEN = 4 | |
28495 | ||
28496 | C main generation loop | |
28497 | 60 CONTINUE | |
28498 | ||
28499 | KSPOM = KSPOMS | |
28500 | KHPOM = KHPOMS | |
28501 | KHDIR = KHDIRS | |
28502 | KSREG = KSREGS | |
28503 | I1 = IPAR1 | |
28504 | I2 = IPAR2 | |
28505 | C reset mother-daugther relations | |
28506 | NHEP = NHEPS | |
28507 | JDAHEP(1,IMOTH1) = JDA11 | |
28508 | JDAHEP(2,IMOTH1) = JDA21 | |
28509 | JDAHEP(1,IMOTH2) = JDA12 | |
28510 | JDAHEP(2,IMOTH2) = JDA22 | |
28511 | ISTHEP(IMOTH1) = ISTH1 | |
28512 | ISTHEP(IMOTH2) = ISTH2 | |
28513 | IPOIX1 = IPOIS1 | |
28514 | IPOIX2 = IPOIS2 | |
28515 | IPOIX3 = IPOIS3 | |
28516 | C rejection counter | |
28517 | ITRY2 = ITRY2+1 | |
28518 | IF(ITRY2.GT.1) THEN | |
28519 | IFAIL(39) = IFAIL(39)+1 | |
28520 | IF(ITRY2.GE.ITRYM) GOTO 50 | |
28521 | ENDIF | |
28522 | C generate two diffractive events | |
28523 | CALL PHO_DIFDIS(I1,I2,IMOTH1,IMOTH2,1.D0,2,MSOFT,MHARD,IREJ) | |
28524 | IF(IREJ.NE.0) GOTO 50 | |
28525 | CALL PHO_DIFDIS(I2,I1,IMOTH1,IMOTH2,1.D0,2,MSOFT,MHARD,IREJ) | |
28526 | IF(IREJ.NE.0) GOTO 50 | |
28527 | C mass of pomeron-pomeron system | |
28528 | DO 100 I2 = NHEP,1,-1 | |
28529 | IF(IDHEP(I2).EQ.990) GOTO 110 | |
28530 | 100 CONTINUE | |
28531 | 110 CONTINUE | |
28532 | DO 120 I1 = I2-1,1,-1 | |
28533 | IF(IDHEP(I1).EQ.990) GOTO 130 | |
28534 | 120 CONTINUE | |
28535 | 130 CONTINUE | |
28536 | DO 140 I=1,4 | |
28537 | PD(I) = PHEP(I,I1)+PHEP(I,I2) | |
28538 | 140 CONTINUE | |
28539 | XMASS = (PD(4)-PD(3))*(PD(4)+PD(3))-PD(1)**2-PD(2)**2 | |
28540 | IF(IDEB(59).GE.20) WRITE(LO,'(1X,A,2I3,E12.4)') | |
28541 | & 'PHO_CDIFF: IPOM1,IPOM2,MASS**2',I1,I2,XMASS | |
28542 | IF(XMASS.LT.0.1D0) GOTO 60 | |
28543 | XMASS = SQRT(XMASS) | |
28544 | IF(XMASS.LT.PARMDL(71)) GOTO 60 | |
28545 | ||
28546 | C sample pomeron-pomeron interaction process | |
28547 | CALL PHO_DIFPRO(4,ISWMDL(17),990,990,XMASS,0.D0,0.D0,1.D0, | |
28548 | & IPROC,ISAM,JSAM,KSAM,IDIR) | |
28549 | ||
28550 | C non-diffractive pomeron-pomeron interactions | |
28551 | IF((IPROC.EQ.1).OR.(IPROC.EQ.8)) THEN | |
28552 | 200 CONTINUE | |
28553 | IF(ISAM+JSAM+KSAM+IDIR.EQ.0) JSAM = 1 | |
28554 | C debug output | |
28555 | IF(IDEB(59).GE.15) WRITE(LO,'(1X,A,/5X,I3,E12.4,4I5)') | |
28556 | & 'PHO_CDIFF: IP,XMASS,ISAM,JSAM,KSAM,IDIR,', | |
28557 | & IP,XMASS,ISAM,JSAM,KSAM,IDIR | |
28558 | C store debug information | |
28559 | IF(IDIR.GT.0) THEN | |
28560 | IPAR = 4 | |
28561 | ELSE IF(KSAM.GT.0) THEN | |
28562 | IPAR = 3 | |
28563 | ELSE IF(ISAM.GT.0) THEN | |
28564 | IPAR = 2 | |
28565 | ELSE | |
28566 | IPAR = 1 | |
28567 | ENDIF | |
28568 | IDDPOM = IPAR | |
28569 | IF(ISAM+JSAM.GT.0) KSDPO = 1 | |
28570 | IF(KSAM+IDIR.GT.0) KHDPO = 1 | |
28571 | KSPOM = ISAM | |
28572 | KSREG = JSAM | |
28573 | KHPOM = KSAM | |
28574 | KHDIR = IDIR | |
28575 | KSTRG = 0 | |
28576 | KSLOO = 0 | |
28577 | C generate pomeron-pomeron interaction | |
28578 | CALL PHO_STDPAR(I1,I2,IGEN,ISAM,JSAM,KSAM,IDIR,IREJ) | |
28579 | IF(IREJ.NE.0) THEN | |
28580 | IFAIL(3) = IFAIL(3)+1 | |
28581 | IF(IPAR.GT.1) THEN | |
28582 | IF(IPAR.EQ.3) IFAIL(9) = IFAIL(9)+1 | |
28583 | IF(IDIR.GT.0) THEN | |
28584 | IFAIL(10) = IFAIL(10)+1 | |
28585 | IDIR = 0 | |
28586 | ELSE IF(KSAM.GT.0) THEN | |
28587 | KSAM = KSAM-1 | |
28588 | ELSE IF(ISAM.GT.0) THEN | |
28589 | ISAM = ISAM-1 | |
28590 | ENDIF | |
28591 | GOTO 200 | |
28592 | ELSE | |
28593 | IF(IDEB(59).GE.2) WRITE(LO,'(1X,A,2I3,E11.3)') | |
28594 | & 'PHO_CDIFF: rejection by PHO_STDPAR (I,IPAR,XM)', | |
28595 | & I,IPAR,XMASS | |
28596 | GOTO 50 | |
28597 | ENDIF | |
28598 | ENDIF | |
28599 | ||
28600 | C diffractive pomeron-pomeron interactions | |
28601 | ELSE | |
28602 | IPOIX2 = IPOIX2+1 | |
28603 | IPORES(IPOIX2) = IPROC | |
28604 | IPOPOS(1,IPOIX2) = I1 | |
28605 | IPOPOS(2,IPOIX2) = I2 | |
28606 | IPAR = 10+IPROC | |
28607 | IDDPOM = IPAR | |
28608 | ENDIF | |
28609 | ||
28610 | C update debug information | |
28611 | KSPOM = KSPOMS+ISAM | |
28612 | KSREG = KSREGS+JSAM | |
28613 | KHPOM = KHPOMS+KSAM | |
28614 | KHDIR = KHDIRS+IDIR | |
28615 | C comment line for central diffraction | |
28616 | CALL PHO_REGPAR(40,4,IPAR,IMOTH1,IMOTH2,PD(1),PD(2),PD(3),PD(4), | |
28617 | & I1,I2,IDHEP(IMOTH1),IDHEP(IMOTH2),IPOS,1) | |
28618 | PHEP(5,IPOS) = XMASS | |
28619 | C debug output | |
28620 | IF(IDEB(59).GE.15) THEN | |
28621 | WRITE(LO,'(2(/1X,A))') 'PHO_CDIFF: output of /POEVT1/', | |
28622 | & '-----------------------------' | |
28623 | CALL PHO_PREVNT(0) | |
28624 | ENDIF | |
28625 | RETURN | |
28626 | ||
28627 | C treatment of rejection | |
28628 | 50 CONTINUE | |
28629 | IREJ = 1 | |
28630 | IFAIL(40) = IFAIL(40)+1 | |
28631 | IF(IDEB(59).GE.3) THEN | |
28632 | WRITE(LO,'(1X,A)') | |
28633 | & 'PHO_CDIFF: rejection (ITRY,ITRYM)',ITRY2,ITRYM | |
28634 | IF(IDEB(59).GE.10) THEN | |
28635 | CALL PHO_PREVNT(0) | |
28636 | ELSE | |
28637 | CALL PHO_PREVNT(-1) | |
28638 | ENDIF | |
28639 | ENDIF | |
28640 | ||
28641 | END | |
28642 | ||
28643 | *$ CREATE PHO_SAMASS.FOR | |
28644 | *COPY PHO_SAMASS | |
28645 | CDECK ID>, PHO_SAMASS | |
28646 | SUBROUTINE PHO_SAMASS(IFLA,RMASS) | |
28647 | C********************************************************************** | |
28648 | C | |
28649 | C resonance mass sampling of quasi elastic processes | |
28650 | C | |
28651 | C input: IFLA PDG number of particle | |
28652 | C IFLA -1 initialization | |
28653 | C IFLA -2 output of statistics | |
28654 | C | |
28655 | C output: RMASS particle mass (in GeV) | |
28656 | C | |
28657 | C********************************************************************** | |
28658 | IMPLICIT DOUBLE PRECISION (A-H,O-Z) | |
28659 | SAVE | |
28660 | ||
28661 | PARAMETER(EPS = 1.D-10 ) | |
28662 | ||
28663 | C input/output channels | |
28664 | INTEGER LI,LO | |
28665 | COMMON /POINOU/ LI,LO | |
28666 | C event debugging information | |
28667 | INTEGER NMAXD | |
28668 | PARAMETER (NMAXD=100) | |
28669 | INTEGER IDEB,KSPOM,KHPOM,KSREG,KHDIR,KACCEP,KSTRG,KHTRG,KSLOO, | |
28670 | & KHLOO,KSDPO,KHDPO,KEVENT,KSOFT,KHARD | |
28671 | COMMON /PODEBG/ IDEB(NMAXD),KSPOM,KHPOM,KSREG,KHDIR,KACCEP,KSTRG, | |
28672 | & KHTRG,KSLOO,KHLOO,KSDPO,KHDPO,KEVENT,KSOFT,KHARD | |
28673 | C model switches and parameters | |
28674 | CHARACTER*8 MDLNA | |
28675 | INTEGER ISWMDL,IPAMDL | |
28676 | DOUBLE PRECISION PARMDL | |
28677 | COMMON /POMDLS/ MDLNA(50),ISWMDL(50),PARMDL(400),IPAMDL(400) | |
28678 | C parameters of the "simple" Vector Dominance Model | |
28679 | DOUBLE PRECISION VMAS,GAMM,RMIN,RMAX,VMSL,VMFA | |
28680 | COMMON /POSVDM/ VMAS(4),GAMM(4),RMIN(4),RMAX(4),VMSL(4),VMFA(4) | |
28681 | ||
28682 | PARAMETER(NTABM=50) | |
28683 | DIMENSION XMA(4,NTABM),XMC(4,NTABM),RMA(4,NTABM) | |
28684 | DIMENSION SUM(4),ICALL(4) | |
28685 | ||
28686 | C***************************************************************** | |
28687 | C initialization of tables | |
28688 | IF(IFLA.EQ.-1) THEN | |
28689 | C | |
28690 | NSTEP = NTABM | |
28691 | DO 102 I=1,4 | |
28692 | ICALL(I) = 0 | |
28693 | DELTAM=(RMAX(I)-RMIN(I))/DBLE(NSTEP-1) | |
28694 | DO 105 K=1,NSTEP | |
28695 | RMA(I,K)=RMIN(I)+DELTAM*DBLE(K-1) | |
28696 | 105 CONTINUE | |
28697 | 102 CONTINUE | |
28698 | C calculate table of dsig/dm | |
28699 | CALL PHO_DSIGDM(RMA,XMA,NSTEP) | |
28700 | C output of table | |
28701 | IF(IDEB(35).GE.1) THEN | |
28702 | WRITE(LO,'(/5X,A)') 'table: mass (GeV) DSIG/DM (mub/GeV)' | |
28703 | WRITE(LO,'(1X,A,/1X,A)') | |
28704 | & ' (m, rho, m, omega, m, phi, m, pi+pi-)', | |
28705 | & ' -------------------------------------------------------' | |
28706 | DO 106 K=1,NSTEP | |
28707 | WRITE(LO,'(1X,8E12.3)') RMA(1,K),XMA(1,K), | |
28708 | & RMA(2,K),XMA(2,K),RMA(3,K),XMA(3,K),RMA(4,K),XMA(4,K) | |
28709 | 106 CONTINUE | |
28710 | ENDIF | |
28711 | C make second table for sampling | |
28712 | DO 109 I=1,4 | |
28713 | SUM(I) = 0.D0 | |
28714 | DO 108 K=2,NSTEP | |
28715 | SUM(I) = SUM(I) + (XMA(I,K-1)+XMA(I,K))/2.D0 | |
28716 | XMC(I,K) = SUM(I) | |
28717 | 108 CONTINUE | |
28718 | 109 CONTINUE | |
28719 | C normalization | |
28720 | DO 118 K=1,NSTEP | |
28721 | DO 119 I=1,4 | |
28722 | XMC(I,K) = XMC(I,K)/XMC(I,NSTEP) | |
28723 | 119 CONTINUE | |
28724 | 118 CONTINUE | |
28725 | IF(IDEB(35).GE.10) THEN | |
28726 | WRITE(LO,'(/5X,A)') 'PHO_DSIGDM: normalized summed table:' | |
28727 | WRITE(LO,'(1X,A,/1X,A)') | |
28728 | & ' (m, rho, m, omega, m, phi, m, pi+pi-)', | |
28729 | & ' -------------------------------------------------------' | |
28730 | DO 120 K=1,NSTEP | |
28731 | WRITE(LO,'(1X,8E12.3)') RMA(1,K),XMC(1,K), | |
28732 | & RMA(2,K),XMC(2,K),RMA(3,K),XMC(3,K),RMA(4,K),XMC(4,K) | |
28733 | 120 CONTINUE | |
28734 | ENDIF | |
28735 | C | |
28736 | C************************************************** | |
28737 | C output of statistics | |
28738 | ELSE IF(IFLA.EQ.-2) THEN | |
28739 | WRITE(LO,'(2(/1X,A))') 'PHO_SAMASS: statistics', | |
28740 | & '----------------------' | |
28741 | WRITE(LO,'(4(/8X,A,I10))') 'rho: ',ICALL(1), | |
28742 | & 'omega: ',ICALL(2),'phi: ',ICALL(3),'pi+pi-:',ICALL(4) | |
28743 | C | |
28744 | C******************************************************** | |
28745 | C sampling of RMASS | |
28746 | ELSE | |
28747 | C quasi-elastic vector meson production | |
28748 | IF(IFLA.EQ.113) THEN | |
28749 | KP = 1 | |
28750 | ELSE IF(IFLA.EQ.223) THEN | |
28751 | KP = 2 | |
28752 | ELSE IF(IFLA.EQ.333) THEN | |
28753 | KP = 3 | |
28754 | ELSE IF(IFLA.EQ.92) THEN | |
28755 | KP = 4 | |
28756 | C quasi-elastic production of h* | |
28757 | ELSE IF(IFLA.EQ.91) THEN | |
28758 | RMASS = 0.35D0 | |
28759 | RETURN | |
28760 | C elastic hadron scattering | |
28761 | ELSE | |
28762 | RMASS = PHO_PMASS(IFLA,1) | |
28763 | IF(IDEB(35).GE.20) WRITE(LO,'(1X,A,I7,E12.3)') | |
28764 | & 'PHO_SAMASS: IFLA,MASS',IFLA,RMASS | |
28765 | RETURN | |
28766 | ENDIF | |
28767 | C | |
28768 | C sample mass of vector mesonsn / two-pi background | |
28769 | XI = DT_RNDM(RMASS) + EPS | |
28770 | C binary search | |
28771 | IF((XMC(KP,1).LE.XI).AND.(XMC(KP,NSTEP).GE.XI)) THEN | |
28772 | KMIN=1 | |
28773 | KMAX=NSTEP | |
28774 | 300 CONTINUE | |
28775 | IF((KMAX-KMIN).EQ.1) GOTO 400 | |
28776 | KK=(KMAX+KMIN)/2 | |
28777 | IF(XI.LE.XMC(KP,KK)) THEN | |
28778 | KMAX=KK | |
28779 | ELSE | |
28780 | KMIN=KK | |
28781 | ENDIF | |
28782 | GOTO 300 | |
28783 | 400 CONTINUE | |
28784 | ELSE | |
28785 | WRITE(LO,'(1X,A)') 'PHO_SAMASS:ERROR:XI out of range' | |
28786 | WRITE(LO,'(5X,A,I7,I6,3E12.4)') 'EVENT,IFLA,XI,XImin,XImax', | |
28787 | & KEVENT,IFLA,XI,XMC(KP,1),XMC(KP,NSTEP) | |
28788 | CALL PHO_ABORT | |
28789 | ENDIF | |
28790 | C fine interpolation | |
28791 | RMASS = RMA(KP,KMIN)+ | |
28792 | & (RMA(KP,KMAX)-RMA(KP,KMIN))/ | |
28793 | & (XMC(KP,KMAX)-XMC(KP,KMIN)) | |
28794 | & *(XI-XMC(KP,KMIN)) | |
28795 | IF(IDEB(35).GE.20) THEN | |
28796 | IF(IDEB(35).GE.25) WRITE(LO,'(1X,A,3E15.3)') | |
28797 | & 'PHO_SAMASS: MLEFT,MRIGHT,RMASS', | |
28798 | & RMA(KP,KMIN),RMA(KP,KMAX),RMASS | |
28799 | WRITE(LO,'(1X,A,I7,E12.3)') 'PHO_SAMASS: IFLA,MASS', | |
28800 | & IFLA,RMASS | |
28801 | ENDIF | |
28802 | ICALL(KP) = ICALL(KP)+1 | |
28803 | ENDIF | |
28804 | END | |
28805 | ||
28806 | *$ CREATE PHO_DSIGDM.FOR | |
28807 | *COPY PHO_DSIGDM | |
28808 | CDECK ID>, PHO_DSIGDM | |
28809 | SUBROUTINE PHO_DSIGDM(RMA,XMA,NSTEP) | |
28810 | C********************************************************************** | |
28811 | C | |
28812 | C differential cross section DSIG/DM of low mass enhancement | |
28813 | C | |
28814 | C input: RMA(4,NTABM) mass values | |
28815 | C output: XMA(4,NTABM) DSIG/DM of resonances | |
28816 | C 1 rho production | |
28817 | C 2 omega production | |
28818 | C 3 phi production | |
28819 | C 4 pi-pi continuum | |
28820 | C | |
28821 | C********************************************************************** | |
28822 | IMPLICIT DOUBLE PRECISION (A-H,O-Z) | |
28823 | SAVE | |
28824 | ||
28825 | PARAMETER ( EPS = 1.D-10 ) | |
28826 | ||
28827 | PARAMETER(NTABM=50) | |
28828 | DIMENSION XMA(4,NTABM),RMA(4,NTABM) | |
28829 | ||
28830 | C input/output channels | |
28831 | INTEGER LI,LO | |
28832 | COMMON /POINOU/ LI,LO | |
28833 | C event debugging information | |
28834 | INTEGER NMAXD | |
28835 | PARAMETER (NMAXD=100) | |
28836 | INTEGER IDEB,KSPOM,KHPOM,KSREG,KHDIR,KACCEP,KSTRG,KHTRG,KSLOO, | |
28837 | & KHLOO,KSDPO,KHDPO,KEVENT,KSOFT,KHARD | |
28838 | COMMON /PODEBG/ IDEB(NMAXD),KSPOM,KHPOM,KSREG,KHDIR,KACCEP,KSTRG, | |
28839 | & KHTRG,KSLOO,KHLOO,KSDPO,KHDPO,KEVENT,KSOFT,KHARD | |
28840 | C model switches and parameters | |
28841 | CHARACTER*8 MDLNA | |
28842 | INTEGER ISWMDL,IPAMDL | |
28843 | DOUBLE PRECISION PARMDL | |
28844 | COMMON /POMDLS/ MDLNA(50),ISWMDL(50),PARMDL(400),IPAMDL(400) | |
28845 | C parameters of the "simple" Vector Dominance Model | |
28846 | DOUBLE PRECISION VMAS,GAMM,RMIN,RMAX,VMSL,VMFA | |
28847 | COMMON /POSVDM/ VMAS(4),GAMM(4),RMIN(4),RMAX(4),VMSL(4),VMFA(4) | |
28848 | ||
28849 | PIMASS = 0.135 | |
28850 | C rho meson shape (mass dependent width) | |
28851 | QRES = SQRT(VMAS(1)**2 - 4.D0*PIMASS**2) | |
28852 | DO 100 I=1,NSTEP | |
28853 | XMASS = RMA(1,I) | |
28854 | QQ = SQRT(XMASS**2 - 4.D0*PIMASS**2) | |
28855 | GAMMA = GAMM(1)*(QQ/QRES)**3 | |
28856 | XMA(1,I) = XMASS*GAMMA*(VMAS(1)/XMASS)**PARMDL(170) | |
28857 | & /((VMAS(1)**2-XMASS**2)**2+VMAS(1)**2*GAMMA**2) | |
28858 | 100 CONTINUE | |
28859 | C omega/phi meson (constant width) | |
28860 | DO 200 K=2,3 | |
28861 | DO 300 I=1,NSTEP | |
28862 | XMASS = RMA(K,I) | |
28863 | XMA(K,I) = XMASS*GAMM(K) | |
28864 | & /((VMAS(K)**2-XMASS**2)**2+VMAS(K)**2*GAMM(K)**2) | |
28865 | 300 CONTINUE | |
28866 | 200 CONTINUE | |
28867 | C pi-pi continuum | |
28868 | DO 400 I=1,NSTEP | |
28869 | XMASS = RMA(4,I) | |
28870 | XMA(4,I) = (XMASS-0.29D0)**2/XMASS | |
28871 | 400 CONTINUE | |
28872 | ||
28873 | END | |
28874 | ||
28875 | *$ CREATE PHO_SDECAY.FOR | |
28876 | *COPY PHO_SDECAY | |
28877 | CDECK ID>, PHO_SDECAY | |
28878 | SUBROUTINE PHO_SDECAY(NPOS,ISP,ILEV) | |
28879 | C********************************************************************** | |
28880 | C | |
28881 | C decay of single resonance of /POEVT1/: | |
28882 | C decay in helicity frame according to polarization, isotropic | |
28883 | C decay and decay with limited transverse phase space possible | |
28884 | C | |
28885 | C ATTENTION: | |
28886 | C reference to particle number of CPC has to exist | |
28887 | C | |
28888 | C input: NPOS position in /POEVT1/ | |
28889 | C ISP 0 decay according to phase space | |
28890 | C 1 decay according to transversal polarization | |
28891 | C 2 decay according to longitudinal polarization | |
28892 | C 3 decay with limited phase space | |
28893 | C ILEV decay mode to use | |
28894 | C 1 strong only | |
28895 | C 2 strong and ew of tau, charm, and bottom | |
28896 | C 3 strong and electro-weak decays | |
28897 | C negative: remove mother resonance after decay | |
28898 | C | |
28899 | C output: /POEVT1/,/POEVT2/ final particles according to decay mode | |
28900 | C | |
28901 | C********************************************************************** | |
28902 | IMPLICIT DOUBLE PRECISION (A-H,O-Z) | |
28903 | SAVE | |
28904 | ||
28905 | PARAMETER ( EPS = 1.D-15, | |
28906 | & DEPS = 1.D-10 ) | |
28907 | ||
28908 | C input/output channels | |
28909 | INTEGER LI,LO | |
28910 | COMMON /POINOU/ LI,LO | |
28911 | C event debugging information | |
28912 | INTEGER NMAXD | |
28913 | PARAMETER (NMAXD=100) | |
28914 | INTEGER IDEB,KSPOM,KHPOM,KSREG,KHDIR,KACCEP,KSTRG,KHTRG,KSLOO, | |
28915 | & KHLOO,KSDPO,KHDPO,KEVENT,KSOFT,KHARD | |
28916 | COMMON /PODEBG/ IDEB(NMAXD),KSPOM,KHPOM,KSREG,KHDIR,KACCEP,KSTRG, | |
28917 | & KHTRG,KSLOO,KHLOO,KSDPO,KHDPO,KEVENT,KSOFT,KHARD | |
28918 | C model switches and parameters | |
28919 | CHARACTER*8 MDLNA | |
28920 | INTEGER ISWMDL,IPAMDL | |
28921 | DOUBLE PRECISION PARMDL | |
28922 | COMMON /POMDLS/ MDLNA(50),ISWMDL(50),PARMDL(400),IPAMDL(400) | |
28923 | C some constants | |
28924 | DOUBLE PRECISION PI,PI2,PI4,GEV2MB,Q_ch,Q_ch2,Q_ch4 | |
28925 | COMMON /POCONS/ PI,PI2,PI4,GEV2MB, | |
28926 | & Q_ch(-6:6),Q_ch2(-6:6),Q_ch4(-6:6) | |
28927 | C standard particle data interface | |
28928 | INTEGER NMXHEP | |
28929 | PARAMETER (NMXHEP=4000) | |
28930 | INTEGER NEVHEP,NHEP,ISTHEP,IDHEP,JMOHEP,JDAHEP | |
28931 | DOUBLE PRECISION PHEP,VHEP | |
28932 | COMMON /POEVT1/ NEVHEP,NHEP,ISTHEP(NMXHEP),IDHEP(NMXHEP), | |
28933 | & JMOHEP(2,NMXHEP),JDAHEP(2,NMXHEP),PHEP(5,NMXHEP), | |
28934 | & VHEP(4,NMXHEP) | |
28935 | C extension to standard particle data interface (PHOJET specific) | |
28936 | INTEGER IMPART,IPHIST,ICOLOR | |
28937 | COMMON /POEVT2/ IMPART(NMXHEP),IPHIST(2,NMXHEP),ICOLOR(2,NMXHEP) | |
28938 | C general particle data | |
28939 | double precision xm_list,tau_list,gam_list, | |
28940 | & xm_psm2_list,xm_vem2_list,xm_b82_list,xm_b102_list, | |
28941 | & xm_bb82_list,xm_bb102_list | |
28942 | integer ich3_list,iba3_list,iq_list, | |
28943 | & id_psm_list,id_vem_list,id_b8_list,id_b10_list | |
28944 | COMMON /POPAR2/ xm_list(300),tau_list(300),gam_list(300), | |
28945 | & xm_psm2_list(6,6),xm_vem2_list(6,6), | |
28946 | & xm_b82_list(6,6,6),xm_b102_list(6,6,6), | |
28947 | & xm_bb82_list(6,6,6,6),xm_bb102_list(6,6,6,6), | |
28948 | & ich3_list(300),iba3_list(300),iq_list(3,300), | |
28949 | & id_psm_list(6,6),id_vem_list(6,6), | |
28950 | & id_b8_list(6,6,6),id_b10_list(6,6,6) | |
28951 | C particle decay data | |
28952 | double precision wg_sec_list | |
28953 | integer idec_list,isec_list | |
28954 | COMMON /POPAR3/ wg_sec_list(500),idec_list(3,300), | |
28955 | & isec_list(3,500) | |
28956 | C auxiliary data for three particle decay | |
28957 | DOUBLE PRECISION ECM,PCM,COD,COF,SIF | |
28958 | COMMON /PO3DCY/ ECM(3),PCM(3),COD(3),COF(3),SIF(3) | |
28959 | ||
28960 | DIMENSION WGHD(20),KCH(20),ID(3) | |
28961 | ||
28962 | IMODE = ABS(ILEV) | |
28963 | IF(IDEB(36).GE.15) WRITE(LO,'(1X,A,3I5)') | |
28964 | & 'PHO_SDECAY: NPOS,ISP,ILEV',NPOS,ISP,ILEV | |
28965 | ||
28966 | C comment entry | |
28967 | IF(ISTHEP(NPOS).GT.11) RETURN | |
28968 | ||
28969 | C particle stable? | |
28970 | IDcpc = IMPART(NPOS) | |
28971 | IF(IDcpc.EQ.0) return | |
28972 | IDabs = iabs(IDcpc) | |
28973 | if(idec_list(1,IDabs).eq.0) return | |
28974 | ||
28975 | C different decay modi (times) | |
28976 | IF(IMODE.EQ.1) THEN | |
28977 | if(idec_list(1,IDabs).ne.1) return | |
28978 | ELSE IF(IMODE.EQ.2) THEN | |
28979 | if(idec_list(1,IDabs).gt.2) return | |
28980 | ELSE IF(IMODE.EQ.3) THEN | |
28981 | if(idec_list(1,IDabs).gt.3) return | |
28982 | ELSE | |
28983 | WRITE(LO,'(/1X,A,I5)') 'PHO_SDECAY: invalid mode (ILEV)',ILEV | |
28984 | CALL PHO_ABORT | |
28985 | ENDIF | |
28986 | ||
28987 | C decay products, check for mass limitations | |
28988 | K = 0 | |
28989 | WGSUM = 0.D0 | |
28990 | AMIST = PHEP(5,NPOS) | |
28991 | DO 100 I=idec_list(2,IDabs),idec_list(3,IDabs) | |
28992 | AMSUM = 0.D0 | |
28993 | DO 200 L=1,3 | |
28994 | ID(L) = isec_list(L,I) | |
28995 | IF(ID(L).NE.0) AMSUM = AMSUM+pho_pmass(ID(L),0) | |
28996 | 200 CONTINUE | |
28997 | IF(AMSUM.LT.AMIST) THEN | |
28998 | K = K+1 | |
28999 | WGHD(K) = wg_sec_list(I) | |
29000 | KCH(K) = I | |
29001 | ENDIF | |
29002 | 100 CONTINUE | |
29003 | IF(K.EQ.0)THEN | |
29004 | WRITE(LO,'(/1X,A,I6,3E12.4)') | |
29005 | & 'PHO_SDECAY: particle mass too small (NPOS,MA,DCYM)', | |
29006 | & NPOS,AMIST,AMSUM | |
29007 | CALL PHO_PREVNT(0) | |
29008 | RETURN | |
29009 | ENDIF | |
29010 | ||
29011 | C sample new decay channel | |
29012 | XI = (DT_RNDM(AMSUM)-EPS)*WGSUM | |
29013 | K = 0 | |
29014 | WGSUM = 0.D0 | |
29015 | 500 CONTINUE | |
29016 | K = K+1 | |
29017 | WGSUM = WGSUM+WGHD(K) | |
29018 | IF(XI.GT.WGSUM) GOTO 500 | |
29019 | IK = KCH(K) | |
29020 | ID(1) = isec_list(1,IK) | |
29021 | ID(2) = isec_list(2,IK) | |
29022 | ID(3) = isec_list(3,IK) | |
29023 | if(IDcpc.lt.0) then | |
29024 | ID(1) = ipho_anti(ID(1)) | |
29025 | ID(2) = ipho_anti(ID(2)) | |
29026 | if(ID(3).ne.0) ID(3) = ipho_anti(ID(3)) | |
29027 | endif | |
29028 | ||
29029 | C rotation | |
29030 | PTOT = SQRT(PHEP(1,NPOS)**2+PHEP(2,NPOS)**2+PHEP(3,NPOS)**2) | |
29031 | CXS = PHEP(1,NPOS)/PTOT | |
29032 | CYS = PHEP(2,NPOS)/PTOT | |
29033 | CZS = PHEP(3,NPOS)/PTOT | |
29034 | C boost | |
29035 | GBET = PTOT/AMIST | |
29036 | GAM = PHEP(4,NPOS)/AMIST | |
29037 | ||
29038 | IF(ID(3).EQ.0) THEN | |
29039 | C two particle decay | |
29040 | CALL PHO_SDECY2(AMIST,pho_pmass(ID(1),0),pho_pmass(ID(2),0),ISP) | |
29041 | ELSE | |
29042 | C three particle decay | |
29043 | CALL PHO_SDECY3(AMIST,pho_pmass(ID(1),0),pho_pmass(ID(2),0), | |
29044 | & pho_pmass(ID(3),0),ISP) | |
29045 | ENDIF | |
29046 | ||
29047 | IF(ILEV.LT.0) THEN | |
29048 | IF(NHEP.NE.NPOS) THEN | |
29049 | WRITE(LO,'(/1X,2A,2I5)') 'PHO_SDECAY:ERROR: ', | |
29050 | & 'cannot remove resonance (NPOS,NHEP)',NPOS,NHEP | |
29051 | CALL PHO_ABORT | |
29052 | ENDIF | |
29053 | IMO1 = JMOHEP(1,NPOS) | |
29054 | IMO2 = JMOHEP(2,NPOS) | |
29055 | NHEP = NHEP-1 | |
29056 | ELSE | |
29057 | IMO1 = NPOS | |
29058 | IMO2 = 0 | |
29059 | ENDIF | |
29060 | IPH1 = IPHIST(1,NPOS) | |
29061 | IPH2 = IPHIST(2,NPOS) | |
29062 | ||
29063 | C back transformation and registration | |
29064 | DO 300 I=1,3 | |
29065 | IF(ID(I).NE.0) THEN | |
29066 | CALL PHO_LTRANS(GAM,GBET,CXS,CYS,CZS,COD(I),COF(I),SIF(I), | |
29067 | & PCM(I),ECM(I),PTOT,CX,CY,CZ,EE) | |
29068 | XX = PTOT*CX | |
29069 | YY = PTOT*CY | |
29070 | ZZ = PTOT*CZ | |
29071 | CALL PHO_REGPAR(1,0,ID(I),IMO1,IMO2,XX,YY,ZZ,EE, | |
29072 | & IPH1,IPH2,0,0,IPOS,1) | |
29073 | ENDIF | |
29074 | 300 CONTINUE | |
29075 | ||
29076 | 400 CONTINUE | |
29077 | C debug output | |
29078 | IF(IDEB(36).GE.20) THEN | |
29079 | WRITE(LO,'(2(/1X,A))') 'PHO_SDECAY: /POEVT1/', | |
29080 | & '--------------------' | |
29081 | CALL PHO_PREVNT(0) | |
29082 | ENDIF | |
29083 | ||
29084 | END | |
29085 | ||
29086 | *$ CREATE PHO_SDECY2.FOR | |
29087 | *COPY PHO_SDECY2 | |
29088 | CDECK ID>, PHO_SDECY2 | |
29089 | SUBROUTINE PHO_SDECY2(UMO,AM1,AM2,ISP) | |
29090 | C********************************************************************** | |
29091 | C | |
29092 | C isotropic/anisotropic two particle decay in CM system, | |
29093 | C (transversely/longitudinally polarized boson into two | |
29094 | C pseudo-scalar mesons) | |
29095 | C | |
29096 | C********************************************************************** | |
29097 | IMPLICIT DOUBLE PRECISION (A-H,O-Z) | |
29098 | SAVE | |
29099 | ||
29100 | C input/output channels | |
29101 | INTEGER LI,LO | |
29102 | COMMON /POINOU/ LI,LO | |
29103 | C auxiliary data for three particle decay | |
29104 | DOUBLE PRECISION ECM,PCM,COD,COF,SIF | |
29105 | COMMON /PO3DCY/ ECM(3),PCM(3),COD(3),COF(3),SIF(3) | |
29106 | ||
29107 | UMO2=UMO*UMO | |
29108 | AM11=AM1*AM1 | |
29109 | AM22=AM2*AM2 | |
29110 | ECM(1)=(UMO2+AM11-AM22)/(2.D0*UMO) | |
29111 | ECM(2)=UMO-ECM(1) | |
29112 | WAU=ECM(1)*ECM(1)-AM11 | |
29113 | IF(WAU.LT.0.D0) THEN | |
29114 | WRITE(LO,'(/1X,A,E12.4)') 'PHO_SDECY2:ERROR:too small mass',WAU | |
29115 | CALL PHO_ABORT | |
29116 | ENDIF | |
29117 | PCM(1)=SQRT(WAU) | |
29118 | PCM(2)=PCM(1) | |
29119 | ||
29120 | CALL PHO_SFECFE(SIF(1),COF(1)) | |
29121 | IF(ISP.EQ.0) THEN | |
29122 | C no polarization | |
29123 | COD(1) = 2.D0*DT_RNDM(UMO)-1.D0 | |
29124 | ELSE IF(ISP.EQ.1) THEN | |
29125 | C transverse polarization | |
29126 | 400 CONTINUE | |
29127 | COD(1) = 2.D0*DT_RNDM(AM22)-1.D0 | |
29128 | SID12 = 1.D0-COD(1)*COD(1) | |
29129 | IF(SID12.LT.DT_RNDM(AM1)) GOTO 400 | |
29130 | ELSE IF(ISP.EQ.2) THEN | |
29131 | C longitudinal polarization | |
29132 | 500 CONTINUE | |
29133 | COD(1) = 2.D0*DT_RNDM(AM2)-1.D0 | |
29134 | COD12 = COD(1)*COD(1) | |
29135 | IF(COD12.LT.DT_RNDM(AM11)) GOTO 500 | |
29136 | ELSE | |
29137 | WRITE(LO,'(/1X,2A,I3)') 'PHO_SDECY2:ERROR: ', | |
29138 | & 'invalid polarization',ISP | |
29139 | CALL PHO_ABORT | |
29140 | ENDIF | |
29141 | ||
29142 | COD(2) = -COD(1) | |
29143 | COF(2) = -COF(1) | |
29144 | SIF(2) = -SIF(1) | |
29145 | ||
29146 | END | |
29147 | ||
29148 | *$ CREATE PHO_SDECY3.FOR | |
29149 | *COPY PHO_SDECY3 | |
29150 | CDECK ID>, PHO_SDECY3 | |
29151 | SUBROUTINE PHO_SDECY3(UMO,AM1,AM2,AM3,ISP) | |
29152 | C********************************************************************** | |
29153 | C | |
29154 | C isotropic/anisotropic three particle decay in CM system, | |
29155 | C (transversely/longitudinally polarized boson into three | |
29156 | C pseudo-scalar mesons) | |
29157 | C | |
29158 | C********************************************************************** | |
29159 | IMPLICIT DOUBLE PRECISION (A-H,O-Z) | |
29160 | SAVE | |
29161 | ||
29162 | PARAMETER ( DEPS = 1.D-30, | |
29163 | & EPS = 1.D-15 ) | |
29164 | ||
29165 | C input/output channels | |
29166 | INTEGER LI,LO | |
29167 | COMMON /POINOU/ LI,LO | |
29168 | C auxiliary data for three particle decay | |
29169 | DOUBLE PRECISION ECM,PCM,COD,COF,SIF | |
29170 | COMMON /PO3DCY/ ECM(3),PCM(3),COD(3),COF(3),SIF(3) | |
29171 | ||
29172 | DIMENSION F(5),XX(5) | |
29173 | ||
29174 | C calculation of maximum of S2 phase space weight | |
29175 | UMOO=UMO+UMO | |
29176 | GU=(AM2+AM3)**2 | |
29177 | GO=(UMO-AM1)**2 | |
29178 | UFAK=1.0000000000001D0 | |
29179 | IF (GU.GT.GO) UFAK=0.99999999999999D0 | |
29180 | OFAK=2.D0-UFAK | |
29181 | GU=GU*UFAK | |
29182 | GO=GO*OFAK | |
29183 | DS2=(GO-GU)/99.D0 | |
29184 | AM11=AM1*AM1 | |
29185 | AM22=AM2*AM2 | |
29186 | AM33=AM3*AM3 | |
29187 | UMO2=UMO*UMO | |
29188 | RHO2=0.D0 | |
29189 | S22=GU | |
29190 | DO 124 I=1,100 | |
29191 | S21=S22 | |
29192 | S22=GU+(I-1.D0)*DS2 | |
29193 | RHO1=RHO2 | |
29194 | RHO2=PHO_XLAM(S22,UMO2,AM11)*PHO_XLAM(S22,AM22,AM33)/(S22+EPS) | |
29195 | IF(RHO2.LT.RHO1) GOTO 125 | |
29196 | 124 CONTINUE | |
29197 | ||
29198 | 125 CONTINUE | |
29199 | S2SUP=(S22-S21)/2.D0+S21 | |
29200 | SUPRHO=PHO_XLAM(S2SUP,UMO2,AM11)*PHO_XLAM(S2SUP,AM22,AM33) | |
29201 | & /(S2SUP+EPS) | |
29202 | SUPRHO=SUPRHO*1.05D0 | |
29203 | XO=S21-DS2 | |
29204 | IF(GU.LT.GO.AND.XO.LT.GU) XO=GU | |
29205 | IF(GU.GT.GO.AND.XO.GT.GU) XO=GU | |
29206 | XX(1)=XO | |
29207 | XX(3)=S22 | |
29208 | X1=(XO+S22)*0.5D0 | |
29209 | XX(2)=X1 | |
29210 | F(3)=RHO2 | |
29211 | F(1)=PHO_XLAM(XO,UMO2,AM11)*PHO_XLAM(XO,AM22,AM33)/(XO+EPS) | |
29212 | F(2)=PHO_XLAM(X1,UMO2,AM11)*PHO_XLAM(X1,AM22,AM33)/(X1+EPS) | |
29213 | DO 126 I=1,16 | |
29214 | X4=(XX(1)+XX(2))*0.5D0 | |
29215 | X5=(XX(2)+XX(3))*0.5D0 | |
29216 | F(4)=PHO_XLAM(X4,UMO2,AM11)*PHO_XLAM(X4,AM22,AM33)/(X4+EPS) | |
29217 | F(5)=PHO_XLAM(X5,UMO2,AM11)*PHO_XLAM(X5,AM22,AM33)/(X5+EPS) | |
29218 | XX(4)=X4 | |
29219 | XX(5)=X5 | |
29220 | DO 128 II=1,5 | |
29221 | IA=II | |
29222 | DO 131 III=IA,5 | |
29223 | IF(F(II).LT.F(III)) THEN | |
29224 | FH=F(II) | |
29225 | F(II)=F(III) | |
29226 | F(III)=FH | |
29227 | FH=XX(II) | |
29228 | XX(II)=XX(III) | |
29229 | XX(III)=FH | |
29230 | ENDIF | |
29231 | 131 CONTINUE | |
29232 | 128 CONTINUE | |
29233 | SUPRHO=F(1) | |
29234 | S2SUP=XX(1) | |
29235 | DO 129 II=1,3 | |
29236 | IA=II | |
29237 | DO 130 III=IA,3 | |
29238 | IF (XX(II).LT.XX(III)) THEN | |
29239 | FH=F(II) | |
29240 | F(II)=F(III) | |
29241 | F(III)=FH | |
29242 | FH=XX(II) | |
29243 | XX(II)=XX(III) | |
29244 | XX(III)=FH | |
29245 | ENDIF | |
29246 | 130 CONTINUE | |
29247 | 129 CONTINUE | |
29248 | 126 CONTINUE | |
29249 | ||
29250 | AM23=(AM2+AM3)**2 | |
29251 | ||
29252 | C selection of S1 | |
29253 | ITH=0 | |
29254 | 200 CONTINUE | |
29255 | ITH=ITH+1 | |
29256 | IF(ITH.GT.200) THEN | |
29257 | WRITE(LO,'(/1X,A,I10)') | |
29258 | & 'PHO_SDECY3:ERROR: too many iterations',ITH | |
29259 | CALL PHO_ABORT | |
29260 | ENDIF | |
29261 | S2=AM23+DT_RNDM(AM2)*((UMO-AM1)**2-AM23) | |
29262 | Y=DT_RNDM(AM23)*SUPRHO | |
29263 | RHO=PHO_XLAM(S2,UMO2,AM11)*PHO_XLAM(S2,AM22,AM33)/S2 | |
29264 | IF(Y.GT.RHO) GOTO 200 | |
29265 | ||
29266 | C selection of S2 | |
29267 | S1=DT_RNDM(AM2)*RHO+AM11+AM22-(S2-UMO2+AM11)*(S2+AM22-AM33) | |
29268 | & /(2.D0*S2)-RHO/2.D0 | |
29269 | S3=UMO2+AM11+AM22+AM33-S1-S2 | |
29270 | ECM(1)=(UMO2+AM11-S2)/UMOO | |
29271 | ECM(2)=(UMO2+AM22-S3)/UMOO | |
29272 | ECM(3)=(UMO2+AM33-S1)/UMOO | |
29273 | PCM(1)=SQRT((ECM(1)+AM1)*(ECM(1)-AM1)) | |
29274 | PCM(2)=SQRT((ECM(2)+AM2)*(ECM(2)-AM2)) | |
29275 | PCM(3)=SQRT((ECM(3)+AM3)*(ECM(3)-AM3)) | |
29276 | ||
29277 | C calculation of angles: TH between p1,p2; TH1 p3,p1; TH2 p3,p2 | |
29278 | IF((PCM(1).LE.EPS).OR.(PCM(2).LE.EPS)) THEN | |
29279 | COSTH=(DT_RNDM(S1)-0.5D0)*2.D0 | |
29280 | ELSE | |
29281 | COSTH=(ECM(1)*ECM(2)+0.5D0*(AM11+AM22-S1))/(PCM(1)*PCM(2)) | |
29282 | ENDIF | |
29283 | COSTH2=(PCM(3)*PCM(3)+PCM(2)*PCM(2)-PCM(1)*PCM(1)) | |
29284 | & /(2.D0*PCM(2)*PCM(3)) | |
29285 | SINTH2=SQRT(1.D0-COSTH2*COSTH2) | |
29286 | SINTH1=COSTH2*SQRT(1.D0-COSTH*COSTH)-COSTH*SINTH2 | |
29287 | COSTH1=COSTH*COSTH2+SINTH2*SQRT(1.D0-COSTH*COSTH) | |
29288 | ||
29289 | C selection of the sperical coordinates of particle 3 | |
29290 | CALL PHO_SFECFE(SIF(3),COF(3)) | |
29291 | IF(ISP.EQ.0) THEN | |
29292 | C no polarization | |
29293 | COD(3) = 2.D0*DT_RNDM(S2)-1.D0 | |
29294 | ELSE IF(ISP.EQ.1) THEN | |
29295 | C transverse polarization | |
29296 | 400 CONTINUE | |
29297 | COD(3) = 2.D0*DT_RNDM(S1)-1.D0 | |
29298 | SID32 = 1.D0-COD(3)*COD(3) | |
29299 | IF(SID32.LT.DT_RNDM(COSTH)) GOTO 400 | |
29300 | ELSE IF(ISP.EQ.2) THEN | |
29301 | C longitudinal polarization | |
29302 | 500 CONTINUE | |
29303 | COD(3) = 2.D0*DT_RNDM(COSTH2)-1.D0 | |
29304 | COD32 = COD(3)*COD(3) | |
29305 | IF(COD32.LT.DT_RNDM(SINTH1)) GOTO 500 | |
29306 | ELSE | |
29307 | WRITE(LO,'(/1X,2A,I3)') 'PHO_SDECY3:ERROR: ', | |
29308 | & 'invalid polarization',ISP | |
29309 | CALL PHO_ABORT | |
29310 | ENDIF | |
29311 | ||
29312 | C selection of the rotation angle of p1-p2 plane along p3 | |
29313 | IF(ISP.EQ.0) THEN | |
29314 | CALL PHO_SFECFE(SFE,CFE) | |
29315 | ELSE | |
29316 | SFE = 0.D0 | |
29317 | CFE = 1.D0 | |
29318 | ENDIF | |
29319 | CX11=-COSTH1 | |
29320 | CY11=SINTH1*CFE | |
29321 | CZ11=SINTH1*SFE | |
29322 | CX22=-COSTH2 | |
29323 | CY22=-SINTH2*CFE | |
29324 | CZ22=-SINTH2*SFE | |
29325 | ||
29326 | SID3 = SQRT((1.D0+COD(3))*(1.D0-COD(3))) | |
29327 | COD(1)=CX11*COD(3)+CZ11*SID3 | |
29328 | IF((1.D0-COD(1)*COD(1)).LT.DEPS) THEN | |
29329 | WRITE(LO,'(1X,A,5E12.4)') 'PHO_SDECY3: COS(TH1) > 1', | |
29330 | & COD(1),COF(3),SID3,CX11,CZ11 | |
29331 | CALL PHO_PREVNT(-1) | |
29332 | ENDIF | |
29333 | ||
29334 | SID1=SQRT((1.D0+COD(1))*(1.D0-COD(1))) | |
29335 | COF(1)=(CX11*SID3*COF(3)-CY11*SIF(3)-CZ11*COD(3)*COF(3))/SID1 | |
29336 | SIF(1)=(CX11*SID3*SIF(3)+CY11*COF(3)-CZ11*COD(3)*SIF(3))/SID1 | |
29337 | COD(2)=CX22*COD(3)+CZ22*SID3 | |
29338 | SID2=SQRT((1.D0+COD(2))*(1.D0-COD(2))) | |
29339 | COF(2)=(CX22*SID3*COF(3)-CY22*SIF(3)-CZ22*COD(3)*COF(3))/SID2 | |
29340 | SIF(2)=(CX22*SID3*SIF(3)+CY22*COF(3)-CZ22*COD(3)*SIF(3))/SID2 | |
29341 | ||
29342 | END | |
29343 | ||
29344 | *$ CREATE PHO_DFMASS.FOR | |
29345 | *COPY PHO_DFMASS | |
29346 | CDECK ID>, PHO_DFMASS | |
29347 | DOUBLE PRECISION FUNCTION PHO_DFMASS(XMIN,XMAX,PREF2,PVIRT2,IMODE) | |
29348 | C********************************************************************** | |
29349 | C | |
29350 | C sampling of Mx diffractive mass distribution within | |
29351 | C limits XMIN, XMAX | |
29352 | C | |
29353 | C input: XMIN,XMAX mass limitations (GeV) | |
29354 | C PREF2 original particle mass/ reference mass | |
29355 | C (squared, GeV**2) | |
29356 | C PVIRT2 particle virtuality | |
29357 | C IMODE M**2 mass distribution | |
29358 | C 1 1/(M**2+Q**2) | |
29359 | C 2 1/(M**2+Q**2)**alpha | |
29360 | C -1 1/(M**2-Mref**2+Q**2) | |
29361 | C -2 1/(M**2-Mref**2+Q**2)**alpha | |
29362 | C | |
29363 | C output: diffractive mass (GeV) | |
29364 | C | |
29365 | C********************************************************************** | |
29366 | IMPLICIT DOUBLE PRECISION (A-H,O-Z) | |
29367 | SAVE | |
29368 | ||
29369 | PARAMETER(EPS = 1.D-10) | |
29370 | ||
29371 | C input/output channels | |
29372 | INTEGER LI,LO | |
29373 | COMMON /POINOU/ LI,LO | |
29374 | C event debugging information | |
29375 | INTEGER NMAXD | |
29376 | PARAMETER (NMAXD=100) | |
29377 | INTEGER IDEB,KSPOM,KHPOM,KSREG,KHDIR,KACCEP,KSTRG,KHTRG,KSLOO, | |
29378 | & KHLOO,KSDPO,KHDPO,KEVENT,KSOFT,KHARD | |
29379 | COMMON /PODEBG/ IDEB(NMAXD),KSPOM,KHPOM,KSREG,KHDIR,KACCEP,KSTRG, | |
29380 | & KHTRG,KSLOO,KHLOO,KSDPO,KHDPO,KEVENT,KSOFT,KHARD | |
29381 | C model switches and parameters | |
29382 | CHARACTER*8 MDLNA | |
29383 | INTEGER ISWMDL,IPAMDL | |
29384 | DOUBLE PRECISION PARMDL | |
29385 | COMMON /POMDLS/ MDLNA(50),ISWMDL(50),PARMDL(400),IPAMDL(400) | |
29386 | C some constants | |
29387 | DOUBLE PRECISION PI,PI2,PI4,GEV2MB,Q_ch,Q_ch2,Q_ch4 | |
29388 | COMMON /POCONS/ PI,PI2,PI4,GEV2MB, | |
29389 | & Q_ch(-6:6),Q_ch2(-6:6),Q_ch4(-6:6) | |
29390 | ||
29391 | IF((XMIN.GE.XMAX).OR.(XMIN.LE.0.3D0)) THEN | |
29392 | WRITE(LO,'(/1X,2A,3E12.4)') 'PHO_DFMASS:ERROR: ', | |
29393 | & 'invalid mass limits',XMIN,XMAX,PREF2 | |
29394 | CALL PHO_PREVNT(-1) | |
29395 | PHO_DFMASS = 0.135D0 | |
29396 | RETURN | |
29397 | ENDIF | |
29398 | ||
29399 | IF(IMODE.GT.0) THEN | |
29400 | PM2 = -PVIRT2 | |
29401 | ELSE | |
29402 | PM2 = PREF2 - PVIRT2 | |
29403 | ENDIF | |
29404 | ||
29405 | C critical pomeron | |
29406 | IF(ABS(IMODE).EQ.1) THEN | |
29407 | XMIN2 = LOG(XMIN**2-PM2) | |
29408 | XMAX2 = LOG(XMAX**2-PM2) | |
29409 | XI = (XMAX2-XMIN2)*DT_RNDM(PM2)+XMIN2 | |
29410 | XMA2 = EXP(XI)+PM2 | |
29411 | ||
29412 | C supercritical pomeron | |
29413 | ELSE IF(ABS(IMODE).EQ.2) THEN | |
29414 | DDELTA = 1.D0-PARMDL(48) | |
29415 | XMIN2 = (XMIN**2-PM2)**DDELTA | |
29416 | XMAX2 = (XMAX**2-PM2)**DDELTA | |
29417 | XI = (XMAX2-XMIN2)*DT_RNDM(PM2)+XMIN2 | |
29418 | XMA2 = XI**(1.D0/DDELTA)+PM2 | |
29419 | ELSE | |
29420 | WRITE(LO,'(/,1X,A,I3)') | |
29421 | & 'PHO_DFMASS:ERROR: unsupported mode',IMODE | |
29422 | CALL PHO_ABORT | |
29423 | ENDIF | |
29424 | ||
29425 | PHO_DFMASS = SQRT(XMA2) | |
29426 | C debug output | |
29427 | IF(IDEB(43).GE.15) THEN | |
29428 | WRITE(LO,'(1X,A,4E12.3)') 'PHO_DFMASS:Mmin,Mmax,Mref,Mass', | |
29429 | & XMIN,XMAX,PREF2,SQRT(XMA2) | |
29430 | ENDIF | |
29431 | ||
29432 | END | |
29433 | ||
29434 | *$ CREATE PHO_DIFSLP.FOR | |
29435 | *COPY PHO_DIFSLP | |
29436 | CDECK ID>, PHO_DIFSLP | |
29437 | SUBROUTINE PHO_DIFSLP(IDF1,IDF2,IVEC1,IVEC2,XM1,XM2,XMX, | |
29438 | & TT,SLWGHT,IREJ) | |
29439 | C********************************************************************** | |
29440 | C | |
29441 | C sampling of T (Mandelstam variable) distribution within | |
29442 | C certain limits TMIN, TMAX | |
29443 | C | |
29444 | C input: IDF1,2 type of diffractive vertex | |
29445 | C 0 elastic/quasi-elastic scattering | |
29446 | C 1 diffraction dissociation | |
29447 | C IVEC1,2 vector meson IDs in case of quasi-elastic | |
29448 | C scattering, otherwise 0 | |
29449 | C XM1 mass of diffractive system 1 (GeV) | |
29450 | C XM2 mass of diffractive system 2 (GeV) | |
29451 | C XMX max. mass of diffractive system (GeV) | |
29452 | C | |
29453 | C output: TT squared momentum transfer ( < 0, GeV**2) | |
29454 | C SLWGHT weight to allow for mass-dependent slope | |
29455 | C IREJ 0 successful sampling | |
29456 | C 1 masses too big for given T range | |
29457 | C | |
29458 | C********************************************************************** | |
29459 | IMPLICIT DOUBLE PRECISION (A-H,O-Z) | |
29460 | SAVE | |
29461 | ||
29462 | PARAMETER(EPS = 1.D-10) | |
29463 | ||
29464 | C input/output channels | |
29465 | INTEGER LI,LO | |
29466 | COMMON /POINOU/ LI,LO | |
29467 | C event debugging information | |
29468 | INTEGER NMAXD | |
29469 | PARAMETER (NMAXD=100) | |
29470 | INTEGER IDEB,KSPOM,KHPOM,KSREG,KHDIR,KACCEP,KSTRG,KHTRG,KSLOO, | |
29471 | & KHLOO,KSDPO,KHDPO,KEVENT,KSOFT,KHARD | |
29472 | COMMON /PODEBG/ IDEB(NMAXD),KSPOM,KHPOM,KSREG,KHDIR,KACCEP,KSTRG, | |
29473 | & KHTRG,KSLOO,KHLOO,KSDPO,KHDPO,KEVENT,KSOFT,KHARD | |
29474 | C model switches and parameters | |
29475 | CHARACTER*8 MDLNA | |
29476 | INTEGER ISWMDL,IPAMDL | |
29477 | DOUBLE PRECISION PARMDL | |
29478 | COMMON /POMDLS/ MDLNA(50),ISWMDL(50),PARMDL(400),IPAMDL(400) | |
29479 | C internal rejection counters | |
29480 | INTEGER NMXJ | |
29481 | PARAMETER (NMXJ=60) | |
29482 | CHARACTER*10 REJTIT | |
29483 | INTEGER IFAIL | |
29484 | COMMON /POLOOP/ IFAIL(NMXJ),REJTIT(NMXJ) | |
29485 | C c.m. kinematics of diffraction | |
29486 | INTEGER NPOSD | |
29487 | DOUBLE PRECISION ECMD,PCMD,PMASSD,PVIRTD,GAMBED, | |
29488 | & SIDD,CODD,SIFD,COFD,PDCMS | |
29489 | COMMON /PODCMS/ ECMD,PCMD,PMASSD(2),PVIRTD(2),GAMBED(4), | |
29490 | & SIDD,CODD,SIFD,COFD,PDCMS(4,2),NPOSD(2) | |
29491 | C cross sections | |
29492 | INTEGER IPFIL,IFAFIL,IFBFIL | |
29493 | DOUBLE PRECISION SIGTOT,SIGELA,SIGVM,SIGINE,SIGNDF,SIGDIR, | |
29494 | & SIGLSD,SIGHSD,SIGLDD,SIGHDD,SIGCDF, | |
29495 | & SIGPOM,SIGREG,SIGHAR,SIGTR1,SIGTR2,SIGLOO, | |
29496 | & SIGDPO,SIG1SO,SIG1HA,SLOEL,SLOVM,SIGCOR, | |
29497 | & FSUP,FSUD,FSUH,ECMFIL,P2AFIL,P2BFIL | |
29498 | COMMON /POCSEC/ SIGTOT,SIGELA,SIGVM(0:4,0:4),SIGINE,SIGNDF,SIGDIR, | |
29499 | & SIGLSD(2),SIGHSD(2),SIGLDD,SIGHDD,SIGCDF(0:4), | |
29500 | & SIGPOM,SIGREG,SIGHAR,SIGTR1(2),SIGTR2(2),SIGLOO, | |
29501 | & SIGDPO(4),SIG1SO,SIG1HA,SLOEL,SLOVM(4,4),SIGCOR, | |
29502 | & FSUP(2),FSUD(2),FSUH(2),ECMFIL,P2AFIL,P2BFIL, | |
29503 | & IPFIL,IFAFIL,IFBFIL | |
29504 | C Reggeon phenomenology parameters | |
29505 | DOUBLE PRECISION ALPOM,ALPOMP,GP,B0POM,ALREG,ALREGP,GR,B0REG, | |
29506 | & GPPP,GPPR,B0PPP,B0PPR,VDMFAC,VDMQ2F,B0HAR,AKFAC | |
29507 | COMMON /POPREG/ ALPOM,ALPOMP,GP(2),B0POM(2), | |
29508 | & ALREG,ALREGP,GR(2),B0REG(2), | |
29509 | & GPPP,GPPR,B0PPP,B0PPR, | |
29510 | & VDMFAC(4),VDMQ2F(4),B0HAR,AKFAC | |
29511 | C parameters of 2x2 channel model | |
29512 | DOUBLE PRECISION PHISUP,RMASS,VAR,AMPFAC,ELAFAC,VFAC | |
29513 | COMMON /PO2CHA/ PHISUP(2),RMASS(2),VAR,AMPFAC(4),ELAFAC(4),VFAC | |
29514 | C parameters of the "simple" Vector Dominance Model | |
29515 | DOUBLE PRECISION VMAS,GAMM,RMIN,RMAX,VMSL,VMFA | |
29516 | COMMON /POSVDM/ VMAS(4),GAMM(4),RMIN(4),RMAX(4),VMSL(4),VMFA(4) | |
29517 | C some constants | |
29518 | DOUBLE PRECISION PI,PI2,PI4,GEV2MB,Q_ch,Q_ch2,Q_ch4 | |
29519 | COMMON /POCONS/ PI,PI2,PI4,GEV2MB, | |
29520 | & Q_ch(-6:6),Q_ch2(-6:6),Q_ch4(-6:6) | |
29521 | ||
29522 | IREJ = 0 | |
29523 | XM12 = XM1**2 | |
29524 | XM22 = XM2**2 | |
29525 | SS = ECMD**2 | |
29526 | C | |
29527 | C range of momentum transfer t | |
29528 | TMIN = -PARMDL(68) | |
29529 | TMAX = -PARMDL(69) | |
29530 | C determine min. abs(t) necessary to produce masses | |
29531 | PCM2 = PCMD**2 | |
29532 | PCMP2 = PHO_XLAM(SS,XM12,XM22)**2/(4.D0*SS) | |
29533 | IF(PCMP2.LE.0.D0) THEN | |
29534 | IREJ = 1 | |
29535 | TT = 0.D0 | |
29536 | RETURN | |
29537 | ENDIF | |
29538 | TMINP = PMASSD(1)**2+XM12+2.D0*PCMD*SQRT(PCMP2) | |
29539 | & -2.D0*SQRT((PMASSD(1)**2+PCM2)*(XM12+PCMP2)) | |
29540 | C | |
29541 | IF(TMINP.LT.TMAX) THEN | |
29542 | IF(IDEB(44).GE.3) THEN | |
29543 | WRITE(LO,'(1X,2A,/5X,5E12.3)') 'PHO_DIFSLP:REJECTION: ', | |
29544 | & 'too large Tmin (XM1/2,TMIN,TMAX,TMINP)', | |
29545 | & XM1,XM2,TMIN,TMAX,TMINP | |
29546 | ENDIF | |
29547 | IFAIL(32) = IFAIL(32)+1 | |
29548 | IREJ = 1 | |
29549 | TT = 0.D0 | |
29550 | RETURN | |
29551 | ENDIF | |
29552 | TMINA = MIN(TMIN,TMINP) | |
29553 | C | |
29554 | C calculation of slope (mass-dependent parametrization) | |
29555 | IF(IDF1+IDF2.GT.0) THEN | |
29556 | C diffraction dissociation | |
29557 | XMP12 = XM1**2+PVIRTD(1) | |
29558 | XMP22 = XM2**2+PVIRTD(2) | |
29559 | XMX1 = SQRT(XMP12) | |
29560 | XMX2 = SQRT(XMP22) | |
29561 | CALL PHO_SCALES(PMASSD(1),PMASSD(2),XMX1,XMX2,SC1,SC2,SB1,SB2) | |
29562 | FAC = 4.D0*(PMASSD(1)*PMASSD(2))**2 | |
29563 | SLOPE = DBLE(IDF1+IDF2)*B0PPP | |
29564 | & +2.D0*(B0POM(1)*SB1+B0POM(2)*SB2+ALPOMP*LOG(SS*FAC | |
29565 | & /((PMASSD(1)**2+XMP12)*(PMASSD(2)**2+XMP22))+PARMDL(47))) | |
29566 | SLOPE = MAX(SLOPE,1.D0) | |
29567 | C | |
29568 | XMA1 = XMX | |
29569 | XMA2 = XMX | |
29570 | IF(IDF1.EQ.0) THEN | |
29571 | XMA1 = XM1 | |
29572 | ELSE IF(IDF1.EQ.0) THEN | |
29573 | XMA2 = XM2 | |
29574 | ENDIF | |
29575 | XMP12 = XMA1**2+PVIRTD(1) | |
29576 | XMP22 = XMA2**2+PVIRTD(2) | |
29577 | XMX1 = SQRT(XMP12) | |
29578 | XMX2 = SQRT(XMP22) | |
29579 | CALL PHO_SCALES(PMASSD(1),PMASSD(2),XMX1,XMX2,SC1,SC2,SB1,SB2) | |
29580 | SLMIN = DBLE(IDF1+IDF2)*B0PPP | |
29581 | & +2.D0*(B0POM(1)*SB1+B0POM(2)*SB2+ALPOMP*LOG(SS*FAC | |
29582 | & /((PMASSD(1)**2+XMP12)*(PMASSD(2)**2+XMP22))+PARMDL(47))) | |
29583 | SLMIN = MAX(SLMIN,1.D0) | |
29584 | ELSE | |
29585 | C elastic/quasi-elastic scattering | |
29586 | IF(ISWMDL(13).EQ.0) THEN | |
29587 | C external slope values | |
ecf67adb | 29588 | WRITE(LO,*) 'PHO_DIFSLP:ERROR: this option is not installed !' |
9aaba0d6 | 29589 | CALL PHO_ABORT |
29590 | ELSE IF(ISWMDL(13).EQ.1) THEN | |
29591 | C model slopes | |
29592 | IF(IVEC1*IVEC2.EQ.0) THEN | |
29593 | SLOPE = SLOEL | |
29594 | ELSE | |
29595 | SLOPE = SLOVM(IVEC1,IVEC2) | |
29596 | ENDIF | |
29597 | SLMIN = SLOPE | |
29598 | ELSE | |
29599 | WRITE(LO,'(/1X,A,I5)') 'SASDSDT:ERROR: invalid ISWMDL(13)', | |
29600 | & ISWMDL(13) | |
29601 | CALL PHO_ABORT | |
29602 | ENDIF | |
29603 | ENDIF | |
29604 | C | |
29605 | C determine max. abs(t) to avoid underflows | |
29606 | TMAXP = -25.D0/SLOPE | |
29607 | TMAXA = MAX(TMAX,TMAXP) | |
29608 | C | |
29609 | IF(TMINA.LT.TMAXA) THEN | |
29610 | IF(IDEB(44).GE.3) THEN | |
29611 | WRITE(LO,'(1X,2A,/5X,5E12.3)') 'PHO_DIFSLP:REJECTION: ', | |
29612 | & 'too small Tmax (XM1/2,TMINA,TMAXA,SLOPE)', | |
29613 | & XM1,XM2,TMINA,TMAXA,SLOPE | |
29614 | ENDIF | |
29615 | IFAIL(32) = IFAIL(32)+1 | |
29616 | IREJ = 1 | |
29617 | TT = 0.D0 | |
29618 | RETURN | |
29619 | ENDIF | |
29620 | C | |
29621 | C sampling from corrected range of T | |
29622 | TMINE = EXP(SLMIN*TMINA) | |
29623 | TMAXE = EXP(SLMIN*TMAXA) | |
29624 | XI = (TMINE-TMAXE)*DT_RNDM(SLMIN)+TMAXE | |
29625 | TT = LOG(XI)/SLMIN | |
29626 | SLWGHT = EXP((SLOPE-SLMIN)*TT) | |
29627 | C | |
29628 | C debug output | |
29629 | IF(IDEB(44).GE.15) THEN | |
29630 | WRITE(LO,'(1X,A,1P,E12.3/5X,A,2I2,2X,2I2,2E10.2,/5X,A,5E10.2)') | |
29631 | & 'PHO_DIFSLP: sampled momentum transfer:',TT, | |
29632 | & 'IDF1/2,IVEC1/2,XM1/2:',IDF1,IDF2,IVEC1,IVEC2,XM1,XM2, | |
29633 | & 'Tmi,Tmx,SLMIN,SLOPE,WGHT:',TMINP,TMAXP,SLMIN,SLOPE,SLWGHT | |
29634 | ENDIF | |
29635 | END | |
29636 | ||
29637 | *$ CREATE PHO_DIFKIN.FOR | |
29638 | *COPY PHO_DIFKIN | |
29639 | CDECK ID>, PHO_DIFKIN | |
29640 | SUBROUTINE PHO_DIFKIN(XMP1,XMP2,TT,PMOM1,PMOM2,IREJ) | |
29641 | C********************************************************************** | |
29642 | C | |
29643 | C calculation of diffractive kinematics | |
29644 | C | |
29645 | C input: XMP1 mass of outgoing particle system 1 (GeV) | |
29646 | C XMP2 mass of outgoing particle system 2 (GeV) | |
29647 | C TT momentum transfer (GeV**2, negative) | |
29648 | C | |
29649 | C output: PMOM1(5) four momentum of outgoing system 1 | |
29650 | C PMOM2(5) four momentum of outgoing system 2 | |
29651 | C IREJ 0 kinematics consistent | |
29652 | C 1 kinematics inconsistent | |
29653 | C | |
29654 | C********************************************************************** | |
29655 | IMPLICIT DOUBLE PRECISION (A-H,O-Z) | |
29656 | SAVE | |
29657 | ||
29658 | PARAMETER(EPS = 1.D-10, | |
29659 | & DEPS = 0.001) | |
29660 | ||
29661 | C input/output channels | |
29662 | INTEGER LI,LO | |
29663 | COMMON /POINOU/ LI,LO | |
29664 | C event debugging information | |
29665 | INTEGER NMAXD | |
29666 | PARAMETER (NMAXD=100) | |
29667 | INTEGER IDEB,KSPOM,KHPOM,KSREG,KHDIR,KACCEP,KSTRG,KHTRG,KSLOO, | |
29668 | & KHLOO,KSDPO,KHDPO,KEVENT,KSOFT,KHARD | |
29669 | COMMON /PODEBG/ IDEB(NMAXD),KSPOM,KHPOM,KSREG,KHDIR,KACCEP,KSTRG, | |
29670 | & KHTRG,KSLOO,KHLOO,KSDPO,KHDPO,KEVENT,KSOFT,KHARD | |
29671 | C c.m. kinematics of diffraction | |
29672 | INTEGER NPOSD | |
29673 | DOUBLE PRECISION ECMD,PCMD,PMASSD,PVIRTD,GAMBED, | |
29674 | & SIDD,CODD,SIFD,COFD,PDCMS | |
29675 | COMMON /PODCMS/ ECMD,PCMD,PMASSD(2),PVIRTD(2),GAMBED(4), | |
29676 | & SIDD,CODD,SIFD,COFD,PDCMS(4,2),NPOSD(2) | |
29677 | C some constants | |
29678 | DOUBLE PRECISION PI,PI2,PI4,GEV2MB,Q_ch,Q_ch2,Q_ch4 | |
29679 | COMMON /POCONS/ PI,PI2,PI4,GEV2MB, | |
29680 | & Q_ch(-6:6),Q_ch2(-6:6),Q_ch4(-6:6) | |
29681 | ||
29682 | DOUBLE PRECISION PMOM1,PMOM2 | |
29683 | DIMENSION PMOM1(5),PMOM2(5) | |
29684 | ||
29685 | C debug output | |
29686 | IF(IDEB(49).GT.10) WRITE(LO,'(1X,A,/5X,5E12.4)') | |
29687 | & 'PHO_DIFKIN: Ecmd,Pcmd,Mini-1,Mini-2,TT:', | |
29688 | & ECMD,PCMD,XMP1,XMP2,TT | |
29689 | ||
29690 | C general kinematic constraints | |
29691 | IREJ = 1 | |
29692 | IF(ECMD.LE.1.1D0*(XMP1+XMP2)) RETURN | |
29693 | ||
29694 | C new squared cms momentum | |
29695 | XMP12 = XMP1**2 | |
29696 | XMP22 = XMP2**2 | |
29697 | SS = ECMD**2 | |
29698 | PCM2 = PCMD**2 | |
29699 | PCMP2 = PHO_XLAM(SS,XMP12,XMP22)**2/(4.D0*SS) | |
29700 | ||
29701 | C new longitudinal/transverse momentum | |
29702 | E1I = SQRT(PCM2+PMASSD(1)**2) | |
29703 | E1F = SQRT(PCMP2+XMP12) | |
29704 | E2F = SQRT(PCMP2+XMP22) | |
29705 | PLONG = (TT+PCM2+PCMP2-(E1I-E1F)**2)/(2.D0*PCMD) | |
29706 | PTRAN = PCMP2-PLONG**2 | |
29707 | ||
29708 | C check consistency of kinematics | |
29709 | IF(PTRAN.LT.0.D0) THEN | |
29710 | IF(IDEB(49).GE.1) THEN | |
29711 | WRITE(LO,'(1X,2A,I10)') 'PHO_DIFKIN: ', | |
29712 | & 'inconsistent kinematics in event call: ',KEVENT | |
29713 | WRITE(LO,'(1X,A,/5X,1p,6E11.3)') | |
29714 | & 'PHO_DIFKIN: XMP1,XMP2,TT,PCMP,PLONG,PTRANS', | |
29715 | & XMP1,XMP2,TT,SQRT(PCMP2),PLONG,SIGN(SQRT(ABS(PTRAN)),PTRAN) | |
29716 | ENDIF | |
29717 | IREJ = 1 | |
29718 | RETURN | |
29719 | ELSE | |
29720 | PTRAN = SQRT(PTRAN) | |
29721 | ENDIF | |
29722 | XI = PI2*DT_RNDM(PTRAN) | |
29723 | ||
29724 | C outgoing momenta in cm. system | |
29725 | PMOM1(4) = E1F | |
29726 | PMOM1(1) = PTRAN*COS(XI) | |
29727 | PMOM1(2) = PTRAN*SIN(XI) | |
29728 | PMOM1(3) = PLONG | |
29729 | PMOM1(5) = XMP1 | |
29730 | ||
29731 | PMOM2(4) = E2F | |
29732 | PMOM2(1) = -PMOM1(1) | |
29733 | PMOM2(2) = -PMOM1(2) | |
29734 | PMOM2(3) = -PLONG | |
29735 | PMOM2(5) = XMP2 | |
29736 | IREJ = 0 | |
29737 | ||
29738 | C debug output / precision check | |
29739 | IF(IDEB(49).GE.0) THEN | |
29740 | C check kinematics | |
29741 | XM1 = (PMOM1(4)-PMOM1(3))*(PMOM1(4)+PMOM1(3)) | |
29742 | & -PMOM1(1)**2-PMOM1(2)**2 | |
29743 | XM1 = SIGN(SQRT(ABS(XM1)),XM1) | |
29744 | XM2 = (PMOM2(4)-PMOM2(3))*(PMOM2(4)+PMOM2(3)) | |
29745 | & -PMOM2(1)**2-PMOM2(2)**2 | |
29746 | XM2 = SIGN(SQRT(ABS(XM2)),XM2) | |
29747 | IF((ABS(XM1-XMP1).GT.DEPS).OR.(ABS(XM1-XMP1).GT.DEPS)) THEN | |
29748 | WRITE(LO,'(1X,2A,/5X,4E11.4)') 'PHO_DIFKIN: ', | |
29749 | & 'inconsistent masses: MINI-1,MOUT-1,MINI-2,MOUT-2', | |
29750 | & XMP1,XM1,XMP2,XM2 | |
29751 | CALL PHO_PREVNT(-1) | |
29752 | ENDIF | |
29753 | C output | |
29754 | IF(IDEB(49).GT.10) THEN | |
29755 | WRITE(LO,'(1X,A,5E11.3,/1X,A,5E11.3)') | |
29756 | & 'PHO_DIFKIN: P1',PMOM1,' P2',PMOM2 | |
29757 | ENDIF | |
29758 | ENDIF | |
29759 | ||
29760 | END | |
29761 | ||
29762 | *$ CREATE PHO_VECRES.FOR | |
29763 | *COPY PHO_VECRES | |
29764 | CDECK ID>, PHO_VECRES | |
29765 | SUBROUTINE PHO_VECRES(IVEC,RMASS,IDPDG,IDBAM) | |
29766 | C********************************************************************** | |
29767 | C | |
29768 | C sampling of vector meson resonance in diffractive processes | |
29769 | C (nothing done for hadrons) | |
29770 | C | |
29771 | C input: /POSVDM/ VDMFAC factors | |
29772 | C | |
29773 | C output: IVEC 0 incoming hadron | |
29774 | C 1 rho 0 | |
29775 | C 2 omega | |
29776 | C 3 phi | |
29777 | C 4 pi+/pi- background | |
29778 | C RMASS mass of vector meson (GeV) | |
29779 | C IDPDG particle ID according to PDG | |
29780 | C IDBAM particle ID according to CPC | |
29781 | C | |
29782 | C********************************************************************** | |
29783 | IMPLICIT DOUBLE PRECISION (A-H,O-Z) | |
29784 | SAVE | |
29785 | ||
29786 | PARAMETER(EPS = 1.D-10) | |
29787 | ||
29788 | C input/output channels | |
29789 | INTEGER LI,LO | |
29790 | COMMON /POINOU/ LI,LO | |
29791 | C event debugging information | |
29792 | INTEGER NMAXD | |
29793 | PARAMETER (NMAXD=100) | |
29794 | INTEGER IDEB,KSPOM,KHPOM,KSREG,KHDIR,KACCEP,KSTRG,KHTRG,KSLOO, | |
29795 | & KHLOO,KSDPO,KHDPO,KEVENT,KSOFT,KHARD | |
29796 | COMMON /PODEBG/ IDEB(NMAXD),KSPOM,KHPOM,KSREG,KHDIR,KACCEP,KSTRG, | |
29797 | & KHTRG,KSLOO,KHLOO,KSDPO,KHDPO,KEVENT,KSOFT,KHARD | |
29798 | C nucleon-nucleus / nucleus-nucleus interface to DPMJET | |
29799 | INTEGER IDEQP,IDEQB,IHFLD,IHFLS | |
29800 | DOUBLE PRECISION ECMN,PCMN,SECM,SPCM,XPSUB,XTSUB | |
29801 | COMMON /POHDFL/ ECMN,PCMN,SECM,SPCM,XPSUB,XTSUB, | |
29802 | & IDEQP(2),IDEQB(2),IHFLD(2,2),IHFLS(2) | |
29803 | C parameters of the "simple" Vector Dominance Model | |
29804 | DOUBLE PRECISION VMAS,GAMM,RMIN,RMAX,VMSL,VMFA | |
29805 | COMMON /POSVDM/ VMAS(4),GAMM(4),RMIN(4),RMAX(4),VMSL(4),VMFA(4) | |
29806 | C some constants | |
29807 | DOUBLE PRECISION PI,PI2,PI4,GEV2MB,Q_ch,Q_ch2,Q_ch4 | |
29808 | COMMON /POCONS/ PI,PI2,PI4,GEV2MB, | |
29809 | & Q_ch(-6:6),Q_ch2(-6:6),Q_ch4(-6:6) | |
29810 | ||
29811 | C particle code translation | |
29812 | DIMENSION ITRANS(4) | |
29813 | C rho0,omega,phi,pi+/pi- | |
29814 | DATA ITRANS /113, 223, 333, 92 / | |
29815 | ||
29816 | IDPDO = IDPDG | |
29817 | C | |
29818 | C vector meson production | |
29819 | IF(IDPDG.EQ.22) THEN | |
29820 | XI = DT_RNDM(RMASS)*(VMFA(1)+VMFA(2)+VMFA(3)+VMFA(4)) | |
29821 | SUM = 0.D0 | |
29822 | DO 55 K=1,4 | |
29823 | SUM = SUM + VMFA(K) | |
29824 | IF(XI.LE.SUM) GOTO 65 | |
29825 | 55 CONTINUE | |
29826 | 65 CONTINUE | |
29827 | C | |
29828 | IDPDG = ITRANS(K) | |
29829 | IDBAM = ipho_pdg2id(IDPDG) | |
29830 | IVEC = K | |
29831 | C sample mass of vector meson | |
29832 | CALL PHO_SAMASS(IDPDG,RMASS) | |
29833 | ||
29834 | C hadronic resonance of multi-pomeron coupling | |
29835 | ELSE IF(IDPDG.EQ.990) THEN | |
29836 | K = 4 | |
29837 | IDPDG = 91 | |
29838 | IDBAM = ipho_pdg2id(IDPDG) | |
29839 | IVEC = 4 | |
29840 | C sample mass of two-pion system | |
29841 | CALL PHO_SAMASS(IDPDG,RMASS) | |
29842 | ||
29843 | C hadron remnants in inucleus interactions | |
29844 | ELSE IF(IDPDG.EQ.81) THEN | |
29845 | IF(IHFLD(1,1).EQ.0) THEN | |
29846 | CALL PHO_SEAFLA(1,IFL1,IFL2,RMASS) | |
29847 | CALL PHO_HACODE(IFL1,IFL2,IDBA1,IDBA2) | |
29848 | ELSE | |
29849 | CALL PHO_HACODE(IHFLD(1,1),IHFLD(1,2),IDBA1,IDBA2) | |
29850 | ENDIF | |
29851 | RMAS1 = PHO_PMASS(IDBA1,0) | |
29852 | RMAS2 = PHO_PMASS(IDBA2,0) | |
29853 | IF((IDBA2.NE.0).AND. | |
29854 | & (DT_RNDM(RMAS1).LT.(RMAS1/(RMAS1+RMAS2)))) THEN | |
29855 | IDBAM = IDBA2 | |
29856 | RMASS = RMAS2 | |
29857 | ELSE | |
29858 | IDBAM = IDBA1 | |
29859 | RMASS = RMAS1 | |
29860 | ENDIF | |
29861 | IDPDG = IPHO_ID2PDG(IDBAM) | |
29862 | IVEC = 0 | |
29863 | ELSE IF(IDPDG.EQ.82) THEN | |
29864 | IF(IHFLD(2,1).EQ.0) THEN | |
29865 | CALL PHO_SEAFLA(2,IFL1,IFL2,RMASS) | |
29866 | CALL PHO_HACODE(IFL1,IFL2,IDBA1,IDBA2) | |
29867 | ELSE | |
29868 | CALL PHO_HACODE(IHFLD(2,1),IHFLD(2,2),IDBA1,IDBA2) | |
29869 | ENDIF | |
29870 | RMAS1 = PHO_PMASS(IDBA1,0) | |
29871 | RMAS2 = PHO_PMASS(IDBA2,0) | |
29872 | IF((IDBA2.NE.0).AND. | |
29873 | & (DT_RNDM(RMAS1).LT.(RMAS1/(RMAS1+RMAS2)))) THEN | |
29874 | IDBAM = IDBA2 | |
29875 | RMASS = RMAS2 | |
29876 | ELSE | |
29877 | IDBAM = IDBA1 | |
29878 | RMASS = RMAS1 | |
29879 | ENDIF | |
29880 | IDPDG = IPHO_ID2PDG(IDBAM) | |
29881 | IVEC = 0 | |
29882 | ENDIF | |
29883 | C debug output | |
29884 | IF(IDEB(47).GE.5) THEN | |
29885 | WRITE(LO,'(1X,A,/10X,3I7,E12.4)') | |
29886 | & 'PHO_VECRES: IDPDG-OLD,IDPDG,IDBAM,MASS', | |
29887 | & IDPDO,IDPDG,IDBAM,RMASS | |
29888 | ENDIF | |
29889 | ||
29890 | END | |
29891 | ||
29892 | *$ CREATE PHO_DIFRES.FOR | |
29893 | *COPY PHO_DIFRES | |
29894 | CDECK ID>, PHO_DIFRES | |
29895 | SUBROUTINE PHO_DIFRES(IDMOTH,IVAL1,IVAL2, | |
29896 | & IDPDG,IDBAM,RMASS,RGAM,RWG,LISTL) | |
29897 | C********************************************************************** | |
29898 | C | |
29899 | C list of resonance states for low mass resonances | |
29900 | C | |
29901 | C input: IDMOTH PDG ID of mother particle | |
29902 | C IVAL1,2 quarks (photon only) | |
29903 | C | |
29904 | C output: IDPDG list of PDG IDs for possible resonances | |
29905 | C IDBAM list of corresponding CPC IDs | |
29906 | C RMASS mass | |
29907 | C RGAMS decay width | |
29908 | C RMASS additional weight factor | |
29909 | C LISTL entries in current list | |
29910 | C | |
29911 | C********************************************************************** | |
29912 | IMPLICIT DOUBLE PRECISION (A-H,O-Z) | |
29913 | SAVE | |
29914 | ||
29915 | DIMENSION IDPDG(10),IDBAM(10),RMASS(10),RGAM(10),RWG(10) | |
29916 | ||
29917 | PARAMETER (EPS = 1.D-10, | |
29918 | & DEPS = 1.D-15) | |
29919 | ||
29920 | C input/output channels | |
29921 | INTEGER LI,LO | |
29922 | COMMON /POINOU/ LI,LO | |
29923 | C event debugging information | |
29924 | INTEGER NMAXD | |
29925 | PARAMETER (NMAXD=100) | |
29926 | INTEGER IDEB,KSPOM,KHPOM,KSREG,KHDIR,KACCEP,KSTRG,KHTRG,KSLOO, | |
29927 | & KHLOO,KSDPO,KHDPO,KEVENT,KSOFT,KHARD | |
29928 | COMMON /PODEBG/ IDEB(NMAXD),KSPOM,KHPOM,KSREG,KHDIR,KACCEP,KSTRG, | |
29929 | & KHTRG,KSLOO,KHLOO,KSDPO,KHDPO,KEVENT,KSOFT,KHARD | |
29930 | C particle ID translation table | |
29931 | integer ID_pdg_list,ID_list,ID_pdg_max | |
29932 | character*12 name_list | |
29933 | COMMON /POPAR1/ ID_pdg_list(300),ID_list(577),name_list(300), | |
29934 | & ID_pdg_max | |
29935 | C general particle data | |
29936 | double precision xm_list,tau_list,gam_list, | |
29937 | & xm_psm2_list,xm_vem2_list,xm_b82_list,xm_b102_list, | |
29938 | & xm_bb82_list,xm_bb102_list | |
29939 | integer ich3_list,iba3_list,iq_list, | |
29940 | & id_psm_list,id_vem_list,id_b8_list,id_b10_list | |
29941 | COMMON /POPAR2/ xm_list(300),tau_list(300),gam_list(300), | |
29942 | & xm_psm2_list(6,6),xm_vem2_list(6,6), | |
29943 | & xm_b82_list(6,6,6),xm_b102_list(6,6,6), | |
29944 | & xm_bb82_list(6,6,6,6),xm_bb102_list(6,6,6,6), | |
29945 | & ich3_list(300),iba3_list(300),iq_list(3,300), | |
29946 | & id_psm_list(6,6),id_vem_list(6,6), | |
29947 | & id_b8_list(6,6,6),id_b10_list(6,6,6) | |
29948 | ||
29949 | DIMENSION RWGHT(20),IRPDG(20),IRBAM(20) | |
29950 | DATA IRPDG /113, 223, 333, 50223, 40113, 60223, 10333, 30113, | |
29951 | & 12212, 42212, -12212, -42212, | |
29952 | & 8*0 / | |
29953 | DATA RWGHT /1.D0, 0.11D0, 0.1D0, 0.11D0, 1.D0, 0.11D0, 0.1D0, | |
29954 | & 1.D0, 1.D0, 1.D0, 1.D0, 1.D0, | |
29955 | & 8*1.D0 / | |
29956 | ||
29957 | DATA init /0/ | |
29958 | ||
29959 | C initialize table | |
29960 | if(init.eq.0) then | |
29961 | do i=1,20 | |
29962 | if(IRPDG(i).ne.0) then | |
29963 | IRBAM(i) = ipho_pdg2id(IRPDG(i)) | |
29964 | endif | |
29965 | enddo | |
29966 | init = 1 | |
29967 | endif | |
29968 | ||
29969 | C copy table with particles and isospin weights | |
29970 | LISTL = 0 | |
29971 | IF(IDMOTH.EQ.22) THEN | |
29972 | I1 = 4 | |
29973 | I2 = 8 | |
29974 | ELSE IF(IDMOTH.EQ.2212) THEN | |
29975 | I1 = 9 | |
29976 | I2 = 10 | |
29977 | ELSE IF(IDMOTH.EQ.-2212) THEN | |
29978 | I1 = 11 | |
29979 | I2 = 12 | |
29980 | ELSE | |
29981 | RETURN | |
29982 | ENDIF | |
29983 | ||
29984 | DO 100 I=I1,I2 | |
29985 | LISTL = LISTL+1 | |
29986 | IDBAM(LISTL) = IRBAM(I) | |
29987 | IDPDG(LISTL) = IRPDG(I) | |
29988 | RMASS(LISTL) = xm_list(iabs(IDBAM(LISTL))) | |
29989 | RGAM(LISTL) = gam_list(iabs(IDBAM(LISTL))) | |
29990 | RWG(LISTL) = RWGHT(I) | |
29991 | 100 CONTINUE | |
29992 | ||
29993 | C debug output | |
29994 | IF(IDEB(85).GE.20) THEN | |
29995 | WRITE(LO,'(1X,A,3I7)') 'PHO_DIFRES: mother,quarks',IDMOTH, | |
29996 | & IVAL1,IVAL2 | |
29997 | DO 200 I=1,LISTL | |
29998 | WRITE(LO,'(1X,I3,2I7,E12.4)') I,IDBAM(I),IDPDG(I),RMASS(I) | |
29999 | 200 CONTINUE | |
30000 | ENDIF | |
30001 | ||
30002 | END | |
30003 | ||
30004 | *$ CREATE PHO_MASSAD.FOR | |
30005 | *COPY PHO_MASSAD | |
30006 | CDECK ID>, PHO_MASSAD | |
30007 | SUBROUTINE PHO_MASSAD(IFLMO,IFL1,IFL2, | |
30008 | & PMASS,XMCON,XMOUT,IDPDG,IDcpc) | |
30009 | C*********************************************************************** | |
30010 | C | |
30011 | C fine-correction of low mass strings to mass of corresponding | |
30012 | C resonance or two particle threshold | |
30013 | C | |
30014 | C input: IFLMO PDG ID of mother particle | |
30015 | C IFL1,2 requested parton flavours | |
30016 | C (not used at the moment) | |
30017 | C PMASS reference mass (mass of mother particle) | |
30018 | C XMCON conjecture of mass | |
30019 | C | |
30020 | C output: XMOUT output mass (adjusted input mass) | |
30021 | C moved ot nearest mass possible | |
30022 | C IDPDG PDG resonance ID | |
30023 | C IDcpc CPC resonance ID | |
30024 | C | |
30025 | C********************************************************************** | |
30026 | IMPLICIT DOUBLE PRECISION (A-H,O-Z) | |
30027 | SAVE | |
30028 | ||
30029 | PARAMETER ( DEPS = 1.D-8 ) | |
30030 | ||
30031 | C input/output channels | |
30032 | INTEGER LI,LO | |
30033 | COMMON /POINOU/ LI,LO | |
30034 | C event debugging information | |
30035 | INTEGER NMAXD | |
30036 | PARAMETER (NMAXD=100) | |
30037 | INTEGER IDEB,KSPOM,KHPOM,KSREG,KHDIR,KACCEP,KSTRG,KHTRG,KSLOO, | |
30038 | & KHLOO,KSDPO,KHDPO,KEVENT,KSOFT,KHARD | |
30039 | COMMON /PODEBG/ IDEB(NMAXD),KSPOM,KHPOM,KSREG,KHDIR,KACCEP,KSTRG, | |
30040 | & KHTRG,KSLOO,KHLOO,KSDPO,KHDPO,KEVENT,KSOFT,KHARD | |
30041 | C model switches and parameters | |
30042 | CHARACTER*8 MDLNA | |
30043 | INTEGER ISWMDL,IPAMDL | |
30044 | DOUBLE PRECISION PARMDL | |
30045 | COMMON /POMDLS/ MDLNA(50),ISWMDL(50),PARMDL(400),IPAMDL(400) | |
30046 | C general particle data | |
30047 | double precision xm_list,tau_list,gam_list, | |
30048 | & xm_psm2_list,xm_vem2_list,xm_b82_list,xm_b102_list, | |
30049 | & xm_bb82_list,xm_bb102_list | |
30050 | integer ich3_list,iba3_list,iq_list, | |
30051 | & id_psm_list,id_vem_list,id_b8_list,id_b10_list | |
30052 | COMMON /POPAR2/ xm_list(300),tau_list(300),gam_list(300), | |
30053 | & xm_psm2_list(6,6),xm_vem2_list(6,6), | |
30054 | & xm_b82_list(6,6,6),xm_b102_list(6,6,6), | |
30055 | & xm_bb82_list(6,6,6,6),xm_bb102_list(6,6,6,6), | |
30056 | & ich3_list(300),iba3_list(300),iq_list(3,300), | |
30057 | & id_psm_list(6,6),id_vem_list(6,6), | |
30058 | & id_b8_list(6,6,6),id_b10_list(6,6,6) | |
30059 | C particle decay data | |
30060 | double precision wg_sec_list | |
30061 | integer idec_list,isec_list | |
30062 | COMMON /POPAR3/ wg_sec_list(500),idec_list(3,300), | |
30063 | & isec_list(3,500) | |
30064 | ||
30065 | DIMENSION XWG(10),RMA(10),RGA(10),RWG(10),IRPDG(10),IRBAM(10) | |
30066 | ||
30067 | XMINP = XMCON | |
30068 | IDPDG = 0 | |
30069 | IDcpc = 0 | |
30070 | XMOUT = XMINP | |
30071 | ||
30072 | C resonance treatment activated? | |
30073 | IF(ISWMDL(23).EQ.0) RETURN | |
30074 | ||
30075 | CALL PHO_DIFRES(IFLMO,IFL1,IFL2,IRPDG,IRBAM,RMA,RGA,RWG,LISTL) | |
30076 | IF(LISTL.LT.1) THEN | |
30077 | IF(IDEB(7).GE.2) WRITE(LO,'(1X,A,3I7)') | |
30078 | & 'PHO_MASSAD: no resonances for (IFMO,IF1,IF2)', | |
30079 | & IFLMO,IFL1,IFL2 | |
30080 | GOTO 50 | |
30081 | ENDIF | |
30082 | C mass small? | |
30083 | PMASSL = (PMASS+0.15D0)**2 | |
30084 | XMINP2 = XMINP**2 | |
30085 | C determine resonance probability | |
30086 | DM2 = 1.1D0 | |
30087 | RPROB = (PMASSL+DM2)*(XMINP2-PMASSL)/(DM2*XMINP2) | |
30088 | IF(RPROB.LT.DT_RNDM(PMASSL)) THEN | |
30089 | C sample new resonance | |
30090 | XWGSUM = 0.D0 | |
30091 | DO 100 I=1,LISTL | |
30092 | XWG(I) = RWG(I)/RMA(I)**2 | |
30093 | XWGSUM = XWGSUM+XWG(I) | |
30094 | 100 CONTINUE | |
30095 | ||
30096 | ITER = 0 | |
30097 | 150 CONTINUE | |
30098 | ITER = ITER+1 | |
30099 | IF(ITER.GE.5) THEN | |
30100 | IDcpc = 0 | |
30101 | IDPDG = 0 | |
30102 | XMOUT = XMINP | |
30103 | GOTO 50 | |
30104 | ENDIF | |
30105 | ||
30106 | I = 0 | |
30107 | XI = XWGSUM*DT_RNDM(XMOUT) | |
30108 | 200 CONTINUE | |
30109 | I = I+1 | |
30110 | XWGSUM = XWGSUM-XWG(I) | |
30111 | IF((XI.LT.XWGSUM).AND.(I.LT.LISTL)) GOTO 200 | |
30112 | IDPDG = IRPDG(I) | |
30113 | IDcpc = IRBAM(I) | |
30114 | GARES = RGA(I) | |
30115 | XMRES = RMA(I) | |
30116 | XMRES2 = XMRES**2 | |
30117 | C sample new mass (from Breit-Wigner cross section) | |
30118 | ALO = ATAN((PMASSL-XMRES2)/(XMRES*GARES)) | |
30119 | AHI = ATAN((5.D0-XMRES2)/(XMRES*GARES)) | |
30120 | XI = (AHI-ALO)*DT_RNDM(XMRES)+ALO | |
30121 | XMOUT = XMRES*GARES*TAN(XI)+XMRES2 | |
30122 | XMOUT = SQRT(XMOUT) | |
30123 | ||
30124 | C check mass for decay | |
30125 | AMDCY = 2.D0*XMRES | |
30126 | ID = abs(IDcpc) | |
30127 | DO 250 IK=idec_list(2,ID),idec_list(3,ID) | |
30128 | AMSUM = 0.D0 | |
30129 | DO 275 I=1,3 | |
30130 | IF(isec_list(I,IK).NE.0) | |
30131 | & AMSUM = AMSUM + xm_list(iabs(isec_list(I,IK))) | |
30132 | 275 CONTINUE | |
30133 | AMDCY = MIN(AMDCY,AMSUM) | |
30134 | 250 CONTINUE | |
30135 | IF(AMDCY.GE.XMOUT) GOTO 150 | |
30136 | ||
30137 | C debug output | |
30138 | IF(IDEB(7).GE.10) | |
30139 | & WRITE(LO,'(1X,2A,/1X,3I6,2E10.3,2I7,2E10.3)') | |
30140 | & 'PHO_MASSAD: ', | |
30141 | & 'IFMO,IF1,IF2,XMCON,XMOUT,IDPDG,IDcpc,RMA,RGA', | |
30142 | & IFLMO,IFL1,IFL2,XMCON,XMOUT,IDPDG,IDcpc,RMA(I),RGA(I) | |
30143 | RETURN | |
30144 | ENDIF | |
30145 | ||
30146 | 50 CONTINUE | |
30147 | C debug output | |
30148 | IF(IDEB(7).GE.15) | |
30149 | & WRITE(LO,'(1X,A,/1X,3I6,2E10.3)') | |
30150 | & 'PHO_MASSAD: string sampled: IFMO,IF1,IF2,XMCON,XMOUT', | |
30151 | & IFLMO,IFL1,IFL2,XMCON,XMOUT | |
30152 | ||
30153 | END | |
30154 | ||
30155 | *$ CREATE PHO_PDF.FOR | |
30156 | *COPY PHO_PDF | |
30157 | CDECK ID>, PHO_PDF | |
30158 | SUBROUTINE PHO_PDF(NPAR,X,SCALE2,P2VIR,PD) | |
30159 | C*************************************************************** | |
30160 | C | |
30161 | C call different PDF sets for different particle types | |
30162 | C | |
30163 | C input: NPAR 1 IGRP(1),ISET(1) | |
30164 | C 2 IGRP(2),ISET(2) | |
30165 | C X momentum fraction | |
30166 | C SCALE2 squared scale (GeV**2) | |
30167 | C P2VIR particle virtuality (positive, GeV**2) | |
30168 | C | |
30169 | C output PD(-6:6) field containing the x*PDF fractions | |
30170 | C | |
30171 | C*************************************************************** | |
30172 | IMPLICIT DOUBLE PRECISION (A-H,O-Z) | |
30173 | SAVE | |
30174 | ||
30175 | DIMENSION PD(-6:6) | |
30176 | ||
30177 | C input/output channels | |
30178 | INTEGER LI,LO | |
30179 | COMMON /POINOU/ LI,LO | |
30180 | C currently activated parton density parametrizations | |
30181 | CHARACTER*8 PDFNAM | |
30182 | INTEGER IPARID,IPAVA,ITYPE,IGRP,ISET,IEXT,NPAOLD | |
30183 | DOUBLE PRECISION PDFLAM,PDFQ2M | |
30184 | COMMON /POPPDF/ PDFLAM(2),PDFQ2M(2),PDFNAM(2),IPARID(2), | |
30185 | & IPAVA(2),ITYPE(2),IGRP(2),ISET(2),IEXT(2),NPAOLD | |
30186 | C event debugging information | |
30187 | INTEGER NMAXD | |
30188 | PARAMETER (NMAXD=100) | |
30189 | INTEGER IDEB,KSPOM,KHPOM,KSREG,KHDIR,KACCEP,KSTRG,KHTRG,KSLOO, | |
30190 | & KHLOO,KSDPO,KHDPO,KEVENT,KSOFT,KHARD | |
30191 | COMMON /PODEBG/ IDEB(NMAXD),KSPOM,KHPOM,KSREG,KHDIR,KACCEP,KSTRG, | |
30192 | & KHTRG,KSLOO,KHLOO,KSDPO,KHDPO,KEVENT,KSOFT,KHARD | |
30193 | C model switches and parameters | |
30194 | CHARACTER*8 MDLNA | |
30195 | INTEGER ISWMDL,IPAMDL | |
30196 | DOUBLE PRECISION PARMDL | |
30197 | COMMON /POMDLS/ MDLNA(50),ISWMDL(50),PARMDL(400),IPAMDL(400) | |
30198 | ||
30199 | DIMENSION PARAM(20),VALUE(20) | |
30200 | CHARACTER*20 PARAM | |
30201 | ||
30202 | REAL XR,P2R,Q2R,F2GM,XPDFGM | |
30203 | DIMENSION XPDFGM(-6:6) | |
30204 | ||
30205 | C check of kinematic boundaries | |
30206 | XI = X | |
30207 | IF(X.GT.1.D0) THEN | |
30208 | IF(IDEB(37).GE.0) THEN | |
30209 | WRITE(LO,'(/,1X,A,E15.8/)') | |
30210 | & 'PHO_PDF: x>1 (corrected to x=1)',X | |
30211 | CALL PHO_PREVNT(-1) | |
30212 | ENDIF | |
30213 | XI = 0.99999999999D0 | |
30214 | ELSE IF(X.LE.0.D0) THEN | |
30215 | IF(IDEB(37).GE.0) THEN | |
30216 | WRITE(LO,'(/,1X,A,E15.8/)') 'PHO_PDF: X <= 0 ',X | |
30217 | CALL PHO_PREVNT(-1) | |
30218 | ENDIF | |
30219 | XI = 0.0001D0 | |
30220 | ENDIF | |
30221 | ||
30222 | DO 100 I=-6,6 | |
30223 | PD(I) = 0.D0 | |
30224 | 100 CONTINUE | |
30225 | IRET = 1 | |
30226 | ||
30227 | IF((NPAR.EQ.1).OR.(NPAR.EQ.2)) THEN | |
30228 | ||
30229 | C internal PDFs | |
30230 | ||
30231 | IF(IEXT(NPAR).EQ.0) THEN | |
30232 | IF(ITYPE(NPAR).EQ.1) THEN | |
30233 | C proton PDFs | |
30234 | IF(IGRP(NPAR).EQ.5) THEN | |
30235 | IF(ISET(NPAR).EQ.3) THEN | |
30236 | CALL PHO_DOR92HO(XI,SCALE2,UDV,DV,GL,UDB,SB,CB,BB) | |
30237 | UV = UDV-DV | |
30238 | UDB = 2.D0*UDB | |
30239 | DEL = 0.D0 | |
30240 | IRET = 0 | |
30241 | ELSE IF(ISET(NPAR).EQ.4) THEN | |
30242 | CALL PHO_DOR92LO(XI,SCALE2,UDV,DV,GL,UDB,SB,CB,BB) | |
30243 | UV = UDV-DV | |
30244 | UDB = 2.D0*UDB | |
30245 | DEL = 0.D0 | |
30246 | IRET = 0 | |
30247 | ELSE IF(ISET(NPAR).EQ.5) THEN | |
30248 | CALL PHO_DOR94HO(XI,SCALE2,UV,DV,DEL,UDB,SB,GL) | |
30249 | C heavy quarks from GRV92-HO | |
30250 | AMU2 = 0.3 | |
30251 | ALAM2 = 0.248 * 0.248 | |
30252 | S = LOG (LOG(SCALE2/ALAM2) / LOG(AMU2/ALAM2)) | |
30253 | SC = 0.820 | |
30254 | ALC = 0.98 | |
30255 | BEC = 0.0 | |
30256 | AKC = -0.625 - 0.523 * S | |
30257 | AGC = 0.0 | |
30258 | BC = 1.896 + 1.616 * S | |
30259 | DC = 4.12 + 0.683 * S | |
30260 | EC = 4.36 + 1.328 * S | |
30261 | ESC = 0.677 + 0.679 * S | |
30262 | CB = PHO_DOR92FS(X,S,SC,ALC,BEC,AKC,AGC,BC,DC,EC,ESC) | |
30263 | SBO = 1.297 | |
30264 | ALB = 0.99 | |
30265 | BEB = 0.0 | |
30266 | AKB = 0.0 - 0.193 * S | |
30267 | AGB = 0.0 | |
30268 | BBO = 0.0 | |
30269 | DB = 3.447 + 0.927 * S | |
30270 | EB = 4.68 + 1.259 * S | |
30271 | ESB = 1.892 + 2.199 * S | |
30272 | BB = PHO_DOR92FS(X,S,SBO,ALB,BEB,AKB,AGB,BBO,DB,EB,ESB) | |
30273 | IRET = 0 | |
30274 | ELSE IF(ISET(NPAR).EQ.6) THEN | |
30275 | CALL PHO_DOR94LO(XI,SCALE2,UV,DV,DEL,UDB,SB,GL) | |
30276 | C heavy quarks from GRV92-LO | |
30277 | AMU2 = 0.25 | |
30278 | ALAM2 = 0.232D0**2 | |
30279 | S = LOG (LOG(SCALE2/ALAM2) / LOG(AMU2/ALAM2)) | |
30280 | SC = 0.888 | |
30281 | ALC = 1.01 | |
30282 | BEC = 0.37 | |
30283 | AKC = 0.0 | |
30284 | AGC = 0.0 | |
30285 | BC = 4.24 - 0.804 * S | |
30286 | DC = 3.46 + 1.076 * S | |
30287 | EC = 4.61 + 1.490 * S | |
30288 | ESC = 2.555 + 1.961 * S | |
30289 | CB = PHO_DOR92FS(X,S,SC,ALC,BEC,AKC,AGC,BC,DC,EC,ESC) | |
30290 | SBO = 1.351 | |
30291 | ALB = 1.00 | |
30292 | BEB = 0.51 | |
30293 | AKB = 0.0 | |
30294 | AGB = 0.0 | |
30295 | BBO = 1.848 | |
30296 | DB = 2.929 + 1.396 * S | |
30297 | EB = 4.71 + 1.514 * S | |
30298 | ESB = 4.02 + 1.239 * S | |
30299 | BB = PHO_DOR92FS(X,S,SBO,ALB,BEB,AKB,AGB,BBO,DB,EB,ESB) | |
30300 | IRET = 0 | |
30301 | ELSE IF(ISET(NPAR).EQ.7) THEN | |
30302 | CALL PHO_DOR94DI(XI,SCALE2, UV, DV, DEL, UDB, SB, GL) | |
30303 | C heavy quarks from GRV92-HO | |
30304 | AMU2 = 0.3 | |
30305 | ALAM2 = 0.248 * 0.248 | |
30306 | S = LOG (LOG(SCALE2/ALAM2) / LOG(AMU2/ALAM2)) | |
30307 | SC = 0.820 | |
30308 | ALC = 0.98 | |
30309 | BEC = 0.0 | |
30310 | AKC = -0.625 - 0.523 * S | |
30311 | AGC = 0.0 | |
30312 | BC = 1.896 + 1.616 * S | |
30313 | DC = 4.12 + 0.683 * S | |
30314 | EC = 4.36 + 1.328 * S | |
30315 | ESC = 0.677 + 0.679 * S | |
30316 | CB = PHO_DOR92FS(X,S,SC,ALC,BEC,AKC,AGC,BC,DC,EC,ESC) | |
30317 | SBO = 1.297 | |
30318 | ALB = 0.99 | |
30319 | BEB = 0.0 | |
30320 | AKB = 0.0 - 0.193 * S | |
30321 | AGB = 0.0 | |
30322 | BBO = 0.0 | |
30323 | DB = 3.447 + 0.927 * S | |
30324 | EB = 4.68 + 1.259 * S | |
30325 | ESB = 1.892 + 2.199 * S | |
30326 | BB = PHO_DOR92FS(X,S,SBO,ALB,BEB,AKB,AGB,BBO,DB,EB,ESB) | |
30327 | IRET = 0 | |
30328 | ELSE IF(ISET(NPAR).EQ.8) THEN | |
30329 | CALL PHO_DOR98LO(XI,SCALE2,UV,DV,US,DS,SB,GL) | |
30330 | DEL = DS-US | |
30331 | UDB = DS+US | |
30332 | C heavy quarks from GRV92-LO | |
30333 | AMU2 = 0.25 | |
30334 | ALAM2 = 0.232D0**2 | |
30335 | S = LOG (LOG(SCALE2/ALAM2) / LOG(AMU2/ALAM2)) | |
30336 | SC = 0.888 | |
30337 | ALC = 1.01 | |
30338 | BEC = 0.37 | |
30339 | AKC = 0.0 | |
30340 | AGC = 0.0 | |
30341 | BC = 4.24 - 0.804 * S | |
30342 | DC = 3.46 + 1.076 * S | |
30343 | EC = 4.61 + 1.490 * S | |
30344 | ESC = 2.555 + 1.961 * S | |
30345 | CB = PHO_DOR92FS(X,S,SC,ALC,BEC,AKC,AGC,BC,DC,EC,ESC) | |
30346 | SBO = 1.351 | |
30347 | ALB = 1.00 | |
30348 | BEB = 0.51 | |
30349 | AKB = 0.0 | |
30350 | AGB = 0.0 | |
30351 | BBO = 1.848 | |
30352 | DB = 2.929 + 1.396 * S | |
30353 | EB = 4.71 + 1.514 * S | |
30354 | ESB = 4.02 + 1.239 * S | |
30355 | BB = PHO_DOR92FS(X,S,SBO,ALB,BEB,AKB,AGB,BBO,DB,EB,ESB) | |
30356 | IRET = 0 | |
30357 | ELSE IF(ISET(NPAR).EQ.9) THEN | |
30358 | * CALL PHO_DOR98SC(XI,SCALE2,UV,DV,US,DS,SB,GL) | |
30359 | DEL = DS-US | |
30360 | UDB = DS+US | |
30361 | C heavy quarks from GRV92-LO | |
30362 | AMU2 = 0.25 | |
30363 | ALAM2 = 0.232D0**2 | |
30364 | S = LOG (LOG(SCALE2/ALAM2) / LOG(AMU2/ALAM2)) | |
30365 | SC = 0.888 | |
30366 | ALC = 1.01 | |
30367 | BEC = 0.37 | |
30368 | AKC = 0.0 | |
30369 | AGC = 0.0 | |
30370 | BC = 4.24 - 0.804 * S | |
30371 | DC = 3.46 + 1.076 * S | |
30372 | EC = 4.61 + 1.490 * S | |
30373 | ESC = 2.555 + 1.961 * S | |
30374 | CB = PHO_DOR92FS(X,S,SC,ALC,BEC,AKC,AGC,BC,DC,EC,ESC) | |
30375 | SBO = 1.351 | |
30376 | ALB = 1.00 | |
30377 | BEB = 0.51 | |
30378 | AKB = 0.0 | |
30379 | AGB = 0.0 | |
30380 | BBO = 1.848 | |
30381 | DB = 2.929 + 1.396 * S | |
30382 | EB = 4.71 + 1.514 * S | |
30383 | ESB = 4.02 + 1.239 * S | |
30384 | BB = PHO_DOR92FS(X,S,SBO,ALB,BEB,AKB,AGB,BBO,DB,EB,ESB) | |
30385 | IRET = 0 | |
30386 | ENDIF | |
30387 | PD(-5) = BB | |
30388 | PD(-4) = CB | |
30389 | PD(-3) = SB | |
30390 | PD(-2) = 0.5D0*(UDB-DEL) | |
30391 | PD(-1) = 0.5D0*(UDB+DEL) | |
30392 | PD(0) = GL | |
30393 | PD(1) = DV+PD(-1) | |
30394 | PD(2) = UV+PD(-2) | |
30395 | PD(3) = PD(-3) | |
30396 | PD(4) = PD(-4) | |
30397 | PD(5) = PD(-5) | |
30398 | ENDIF | |
30399 | ELSE IF(ITYPE(NPAR).EQ.2) THEN | |
30400 | C pion PDFs (default for pi+) | |
30401 | IF(IGRP(NPAR).EQ.5) THEN | |
30402 | IF(ISET(NPAR).EQ.1) THEN | |
30403 | CALL PHO_DORPHO (XI,SCALE2,VA,GL,QB,CB,BB) | |
30404 | IRET = 0 | |
30405 | ELSE IF(ISET(NPAR).EQ.2) THEN | |
30406 | CALL PHO_DORPLO (XI,SCALE2,VA,GL,QB,CB,BB) | |
30407 | IRET = 0 | |
30408 | ENDIF | |
30409 | PD(-5) = BB | |
30410 | PD(-4) = CB | |
30411 | PD(-3) = QB | |
30412 | PD(-2) = QB | |
30413 | PD(-1) = QB+VA | |
30414 | PD(0) = GL | |
30415 | PD(1) = QB | |
30416 | PD(2) = VA+QB | |
30417 | PD(3) = QB | |
30418 | PD(4) = CB | |
30419 | PD(5) = BB | |
30420 | ENDIF | |
30421 | ELSE IF(ITYPE(NPAR).EQ.3) THEN | |
30422 | C photon PDFs | |
30423 | IF(IGRP(NPAR).EQ.5) THEN | |
30424 | IF(ISET(NPAR).EQ.1) THEN | |
30425 | CALL PHO_DORGH0 (XI,SCALE2,UB,DB,SB,CB,BB,GL) | |
30426 | IRET = 0 | |
30427 | ELSE IF(ISET(NPAR).EQ.2) THEN | |
30428 | CALL PHO_DORGHO (XI,SCALE2,UB,DB,SB,CB,BB,GL) | |
30429 | IRET = 0 | |
30430 | ELSE IF(ISET(NPAR).EQ.3) THEN | |
30431 | CALL PHO_DORGLO (XI,SCALE2,UB,DB,SB,CB,BB,GL) | |
30432 | IRET = 0 | |
30433 | ENDIF | |
30434 | C reweight with Drees-Godbole factor | |
30435 | WGX = 1.D0 | |
30436 | IF(P2VIR.GT.0.001D0) THEN | |
30437 | WGX = LOG(SCALE2/(P2VIR+PARMDL(144))) | |
30438 | & /LOG(SCALE2/PARMDL(144)) | |
30439 | WGX = MAX(WGX,0.D0) | |
30440 | ENDIF | |
30441 | PD(-5) = BB*WGX/137.D0 | |
30442 | PD(-4) = CB*WGX/137.D0 | |
30443 | PD(-3) = SB*WGX/137.D0 | |
30444 | PD(-2) = UB*WGX/137.D0 | |
30445 | PD(-1) = DB*WGX/137.D0 | |
30446 | PD(0) = GL*WGX*WGX/137.D0 | |
30447 | PD(1) = PD(-1) | |
30448 | PD(2) = PD(-2) | |
30449 | PD(3) = PD(-3) | |
30450 | PD(4) = PD(-4) | |
30451 | PD(5) = PD(-5) | |
30452 | ELSE IF(IGRP(NPAR).EQ.8) THEN | |
30453 | IF(ISET(NPAR).EQ.1) THEN | |
30454 | CALL PHO_PHGAL (XI,SCALE2,PD) | |
30455 | IRET = 0 | |
30456 | ENDIF | |
30457 | ENDIF | |
30458 | ELSE IF(ITYPE(NPAR).EQ.20) THEN | |
30459 | C Pomeron PDFs | |
30460 | MODE = IGRP(NPAR) | |
30461 | IF(MODE.EQ.1) THEN | |
30462 | PD(0) = 6.D0*(1.D0-XI)**5*PARMDL(26)*PARMDL(78) | |
30463 | IRET = 0 | |
30464 | ELSE IF(MODE.EQ.2) THEN | |
30465 | PD(0) = 6.D0*XI*(1.D0-XI)*PARMDL(26)*PARMDL(78) | |
30466 | IRET = 0 | |
30467 | ELSE IF(MODE.EQ.3) THEN | |
30468 | PD(0) = (0.18D0/XI+5.46D0)*(1.D0-XI)*PARMDL(26)*PARMDL(78) | |
30469 | IRET = 0 | |
30470 | ELSE IF(MODE.EQ.4) THEN | |
30471 | CALL PHO_CKMTPD(990,XI,SCALE2,PD) | |
30472 | DO 105 I=-4,4 | |
30473 | PD(I) = PD(I)*PARMDL(78) | |
30474 | 105 CONTINUE | |
30475 | IRET = 0 | |
30476 | ENDIF | |
30477 | ENDIF | |
30478 | ||
30479 | C external PDFs | |
30480 | ||
30481 | ELSE IF(IEXT(NPAR).EQ.2) THEN | |
30482 | C PDFLIB call: new PDF numbering | |
30483 | IF(NPAR.NE.NPAOLD) THEN | |
30484 | PARAM(1) = 'NPTYPE' | |
30485 | PARAM(2) = 'NGROUP' | |
30486 | PARAM(3) = 'NSET' | |
30487 | PARAM(4) = ' ' | |
30488 | VALUE(1) = ITYPE(NPAR) | |
30489 | VALUE(2) = ABS(IGRP(NPAR)) | |
30490 | VALUE(3) = ISET(NPAR) | |
30491 | CALL PDFSET(PARAM,VALUE) | |
30492 | ENDIF | |
30493 | IF(ITYPE(NPAR).EQ.3) THEN | |
30494 | IP2 = 0 | |
30495 | CALL STRUCTP(XI,SCALE2,P2VIR,IP2,PD(2),PD(1),PD(-2),PD(-1), | |
30496 | & PD(-3),PD(-4),PD(-5),PD(-6),PD(0)) | |
30497 | ELSE | |
30498 | SCALE = SQRT(SCALE2) | |
30499 | CALL STRUCTM(XI,SCALE,PD(2),PD(1),PD(-2),PD(-1), | |
30500 | & PD(-3),PD(-4),PD(-5),PD(-6),PD(0)) | |
30501 | ENDIF | |
30502 | DO 115 I=3,6 | |
30503 | PD(I) = PD(-I) | |
30504 | 115 CONTINUE | |
30505 | IF(ITYPE(NPAR).EQ.1) THEN | |
30506 | C proton valence quarks | |
30507 | PD(1) = PD(1)+PD(-1) | |
30508 | PD(2) = PD(2)+PD(-2) | |
30509 | ELSE IF(ITYPE(NPAR).EQ.2) THEN | |
30510 | C pi+ valences | |
30511 | DVAL = PD(1) | |
30512 | PD(1) = PD(-1) | |
30513 | PD(-1) = DVAL+PD(1) | |
30514 | PD(2) = PD(2)+PD(-2) | |
30515 | ELSE IF(ITYPE(NPAR).EQ.3) THEN | |
30516 | C photon conventions | |
30517 | PD(1) = PD(-1) | |
30518 | PD(2) = PD(-2) | |
30519 | ENDIF | |
30520 | IRET = 0 | |
30521 | ||
30522 | ELSE IF(IEXT(NPAR).EQ.3) THEN | |
30523 | C PHOLIB call: version 2.0 | |
30524 | CALL PHVAL(IGRP(NPAR),ISET(NPAR),XI,SCALE2,PD,IRET) | |
30525 | IF(IRET.LT.0) THEN | |
30526 | WRITE(LO,'(/1X,A,I2)') | |
30527 | & 'PHO_PDF:ERROR: non-vanishing PHVAL return code',IRET | |
30528 | CALL PHO_ABORT | |
30529 | ENDIF | |
30530 | IRET = 0 | |
30531 | ||
30532 | C photon PDFs depending on photon virtuality | |
30533 | ||
30534 | ELSE IF(IEXT(NPAR).EQ.4) THEN | |
30535 | IF(IGRP(NPAR).EQ.1) THEN | |
30536 | C Schuler/Sjostrand PDF (interface to single precision) | |
30537 | XR = XI | |
30538 | Q2R = SCALE2 | |
30539 | P2R = P2VIR | |
30540 | IP2 = 0 | |
30541 | CALL PHO_SASGAM(ISET(NPAR),XR,Q2R,P2R,IP2,F2GM,XPDFGM) | |
30542 | DO 120 I=-6,6 | |
30543 | PD(I) = DBLE(XPDFGM(I)) | |
30544 | 120 CONTINUE | |
30545 | IRET = 0 | |
30546 | ELSE IF(IGRP(NPAR).EQ.5) THEN | |
30547 | C Gluck/Reya/Stratmann | |
30548 | IF(ISET(NPAR).EQ.4) THEN | |
30549 | CALL PHO_DORGLV (XI,SCALE2,P2VIR, UB, DB, SB, GL) | |
30550 | CALL PHO_QPMPDF(4,XI,SCALE2,0.D0,P2VIR,CB) | |
30551 | IRET = 0 | |
30552 | PD(-5) = 0.D0 | |
30553 | PD(-4) = CB | |
30554 | PD(-3) = SB/137.D0 | |
30555 | PD(-2) = UB/137.D0 | |
30556 | PD(-1) = DB/137.D0 | |
30557 | PD(0) = GL/137.D0 | |
30558 | PD(1) = PD(-1) | |
30559 | PD(1) = PD(-1) | |
30560 | PD(2) = PD(-2) | |
30561 | PD(3) = PD(-3) | |
30562 | PD(4) = PD(-4) | |
30563 | PD(5) = PD(-5) | |
30564 | ENDIF | |
30565 | ENDIF | |
30566 | ENDIF | |
30567 | ||
30568 | C check for errors | |
30569 | ||
30570 | IF(IRET.NE.0) THEN | |
30571 | WRITE(LO,'(/1X,A,/10X,5I6)') | |
30572 | & 'PHO_PDF:ERROR:unsupported PDF(NPAR,IEXT,ITYPE,IGRP,ISET)', | |
30573 | & NPAR,IEXT(NPAR),ITYPE(NPAR),IGRP(NPAR),ISET(NPAR) | |
30574 | CALL PHO_ABORT | |
30575 | ENDIF | |
30576 | C error in NPAR | |
30577 | ELSE | |
30578 | WRITE(LO,'(/1X,A,I5)') 'PHO_PDF:ERROR:invalid NPAR(1,2) ',NPAR | |
30579 | CALL PHO_ABORT | |
30580 | ENDIF | |
30581 | NPAOLD = NPAR | |
30582 | ||
30583 | C valence quark treatment | |
30584 | ||
30585 | IF(ITYPE(NPAR).EQ.2) THEN | |
30586 | C meson conventions | |
30587 | IF(IPARID(NPAR).EQ.111) THEN | |
30588 | C pi0 valence quarks | |
30589 | PD(-1) = (PD(1)+PD(-1))/2.D0 | |
30590 | PD(1) = PD(-1) | |
30591 | PD(-2) = (PD(2)+PD(-2))/2.D0 | |
30592 | PD(2) = PD(-2) | |
30593 | ELSE IF(ABS(IPARID(NPAR)).EQ.321) THEN | |
30594 | C K+/- | |
30595 | VALS = PD(-1)-PD(1) | |
30596 | PD(-1) = PD(1) | |
30597 | PD(-3) = PD(-3)+VALS | |
30598 | ELSE IF( (IPARID(NPAR).EQ.311) | |
30599 | & .OR.(IPARID(NPAR).EQ.310) | |
30600 | & .OR.(IPARID(NPAR).EQ.130)) THEN | |
30601 | C neutral kaons | |
30602 | VALS = PD(-1)-PD(1) | |
30603 | VALU = PD(2)-PD(-2) | |
30604 | PD(-1) = PD(1) | |
30605 | PD(2) = PD(-2) | |
30606 | PD(2) = PD(2)+VALU/2.D0 | |
30607 | PD(-2) = PD(-2)+VALU/2.D0 | |
30608 | PD(3) = PD(3)+VALS/2.D0 | |
30609 | PD(-3) = PD(-3)+VALS/2.D0 | |
30610 | ENDIF | |
30611 | ELSE IF(ITYPE(NPAR).EQ.1) THEN | |
30612 | C nucleon conventions | |
30613 | IF(ABS(IPARID(NPAR)).EQ.2112) THEN | |
30614 | C neutron valence quarks | |
30615 | DUM = PD(1) | |
30616 | PD(1) = PD(2) | |
30617 | PD(2) = DUM | |
30618 | ELSE IF(ABS(IPARID(NPAR)).EQ.3222) THEN | |
30619 | C (anti-)sigma+ | |
30620 | VALS = PD(1)-PD(-1) | |
30621 | PD(1) = PD(-1) | |
30622 | PD(3) = PD(3)+VALS | |
30623 | ELSE IF(ABS(IPARID(NPAR)).EQ.3112) THEN | |
30624 | C (anti-)sigma- | |
30625 | VALS = PD(1)-PD(-1) | |
30626 | VALD = PD(2)-PD(-2) | |
30627 | PD(1) = PD(-1) | |
30628 | PD(2) = PD(-2) | |
30629 | PD(1) = PD(1)+VALD | |
30630 | PD(3) = PD(3)+VALS | |
30631 | ELSE IF( (ABS(IPARID(NPAR)).EQ.3122) | |
30632 | & .OR.(ABS(IPARID(NPAR)).EQ.3212)) THEN | |
30633 | C (anti-)sigma0 and (anti-)lambda | |
30634 | VALS = PD(1)-PD(-1) | |
30635 | VALD = (PD(2)-PD(-2))/2.D0 | |
30636 | PD(1) = PD(-1) | |
30637 | PD(2) = PD(-2) | |
30638 | PD(1) = PD(1)+VALD | |
30639 | PD(2) = PD(2)+VALD | |
30640 | PD(3) = PD(3)+VALS | |
30641 | ENDIF | |
30642 | ENDIF | |
30643 | ||
30644 | C antiparticle | |
30645 | IF(IPARID(NPAR).LT.0) THEN | |
30646 | DO 190 I=1,4 | |
30647 | DUM=PD(I) | |
30648 | PD(I)=PD(-I) | |
30649 | PD(-I)=DUM | |
30650 | 190 CONTINUE | |
30651 | ENDIF | |
30652 | ||
30653 | C optionally remove valence quarks | |
30654 | IF(IPAVA(NPAR).EQ.0) THEN | |
30655 | DO 200 I=1,4 | |
30656 | PD(I) = MIN(PD(-I),PD(I)) | |
30657 | PD(-I) = PD(I) | |
30658 | 200 CONTINUE | |
30659 | ENDIF | |
30660 | ||
30661 | C debug information | |
30662 | IF(IDEB(37).GE.30) WRITE(LO, | |
30663 | & '(1X,A,I4,1P,3E12.4/,2X,A,6E10.3,/2X,A,E10.3,/2X,A,6E10.3)') | |
30664 | & 'PHO_PDF: NPAR,X,SCALE**2,P2VIR', | |
30665 | & NPAR,X,SCALE2,P2VIR,'PD(-6..-1)',(PD(I),I=-6,-1), | |
30666 | & 'PD(0) ',PD(0),'PD(1..6) ',(PD(I),I=1,6) | |
30667 | ||
30668 | END | |
30669 | ||
30670 | *$ CREATE PHO_QPMPDF.FOR | |
30671 | *COPY PHO_QPMPDF | |
30672 | CDECK ID>, PHO_QPMPDF | |
30673 | SUBROUTINE PHO_QPMPDF(IQ,X,SCALE2,PTREF,PVIRT,FXP) | |
30674 | C*************************************************************** | |
30675 | C | |
30676 | C contribution to photon PDF from box graph | |
30677 | C (Bethe-Heitler process) | |
30678 | C | |
30679 | C input: IQ quark flavour | |
30680 | C SCALE2 scale (GeV**2, positive) | |
30681 | C PTREF reference scale (GeV, positive) | |
30682 | C X parton momentum fraction | |
30683 | C PVIRT photon virtuality (GeV**2, positive) | |
30684 | C FXP x*f(x,Q**2), x times parton density | |
30685 | C | |
30686 | C*************************************************************** | |
30687 | IMPLICIT DOUBLE PRECISION (A-H,O-Z) | |
30688 | SAVE | |
30689 | ||
30690 | C input/output channels | |
30691 | INTEGER LI,LO | |
30692 | COMMON /POINOU/ LI,LO | |
30693 | C event debugging information | |
30694 | INTEGER NMAXD | |
30695 | PARAMETER (NMAXD=100) | |
30696 | INTEGER IDEB,KSPOM,KHPOM,KSREG,KHDIR,KACCEP,KSTRG,KHTRG,KSLOO, | |
30697 | & KHLOO,KSDPO,KHDPO,KEVENT,KSOFT,KHARD | |
30698 | COMMON /PODEBG/ IDEB(NMAXD),KSPOM,KHPOM,KSREG,KHDIR,KACCEP,KSTRG, | |
30699 | & KHTRG,KSLOO,KHLOO,KSDPO,KHDPO,KEVENT,KSOFT,KHARD | |
30700 | C internal rejection counters | |
30701 | INTEGER NMXJ | |
30702 | PARAMETER (NMXJ=60) | |
30703 | CHARACTER*10 REJTIT | |
30704 | INTEGER IFAIL | |
30705 | COMMON /POLOOP/ IFAIL(NMXJ),REJTIT(NMXJ) | |
30706 | C some constants | |
30707 | DOUBLE PRECISION PI,PI2,PI4,GEV2MB,Q_ch,Q_ch2,Q_ch4 | |
30708 | COMMON /POCONS/ PI,PI2,PI4,GEV2MB, | |
30709 | & Q_ch(-6:6),Q_ch2(-6:6),Q_ch4(-6:6) | |
30710 | ||
30711 | DIMENSION QM(6) | |
30712 | DATA QM / 0.2D0,0.25D0,0.5D0,1.5D0,4.5D0,174.D0 / | |
30713 | ||
30714 | FXP = 0.D0 | |
30715 | I = ABS(IQ) | |
30716 | C | |
30717 | * QM2 = MAX(QM(I),PTREF)**2 | |
30718 | * QM2 = MAX(QM2,PVIRT) | |
30719 | * BBE = (1.D0-X)*SCALE2 | |
30720 | * IF(BBE.LE.0.D0) THEN | |
30721 | * IF(IDEB(27).GE.5) WRITE(LO,'(1X,A,4E10.3)') | |
30722 | * & 'PHO_QPMPDF: over mass limit (X,Q2,P2,QM)',X,SCALE2, | |
30723 | * & PVIRT,QM(I) | |
30724 | * ENDIF | |
30725 | * FXP = X*(4.D0-3.D0*MOD(I,2))/9.D0*3.D0/(2.D0*137.D0*PI) | |
30726 | * & *((X**2+(1.D0-X)**2)*LOG(BBE/(QM2*X))+8.D0*X*(1.D0-X)-1.D0) | |
30727 | C Bethe-Heitler process approximation for 2*x*p2/q2 << 1 | |
30728 | QM2 = MAX(QM(I),PTREF)**2 | |
30729 | W2 = SCALE2/X*(1.D0-X-X*PVIRT/SCALE2) | |
30730 | IF(W2.GT.4.D0*QM2) THEN | |
30731 | BE = SQRT(1.D0-4.D0*QM2/W2) | |
30732 | BP = SQRT(1.D0+BE*(1.D0-4.D0*X*X*PVIRT/SCALE2)) | |
30733 | BM = SQRT(1.D0-BE*(1.D0-4.D0*X*X*PVIRT/SCALE2)) | |
30734 | * FXP = X*(4.D0-3.D0*MOD(I,2))/9.D0*3.D0/(137.D0*PI)*(BE*(-1.D0 | |
30735 | FXP = X*Q_ch2(I)*3.D0/(137.D0*PI)*(BE*(-1.D0 | |
30736 | & +6.D0*X-6.D0*X*X)+2.D0*X*X*((2.D0*QM2-PVIRT)/SCALE2 | |
30737 | & -4.D0*QM2*QM2/SCALE2**2)*(1.D0/BM-1.D0/BP) | |
30738 | & +(X*X+(1.D0-X)**2+X*(1-3.D0*X)*4.D0*QM2/SCALE2 | |
30739 | & -X*X*8.D0*QM2*QM2/SCALE2**2)*LOG(BP/BM)) | |
30740 | ELSE | |
30741 | IF(IDEB(27).GE.5) WRITE(LO,'(1X,A,4E10.3)') | |
30742 | & 'PHO_QPMPDF: under mass limit (X,Q2,P2,QM)',X,SCALE2, | |
30743 | & PVIRT,QM(I) | |
30744 | ENDIF | |
30745 | C debug output | |
30746 | IF(IDEB(27).GE.20) WRITE(LO,'(1X,A,I3,1P,5E10.3)') | |
30747 | & 'PHO_QPMPDF: X,Q2,P2,QM',I,X,SCALE2,PVIRT,QM(I),FXP | |
30748 | END | |
30749 | ||
30750 | *$ CREATE PHO_SETPDF.FOR | |
30751 | *COPY PHO_SETPDF | |
30752 | CDECK ID>, PHO_SETPDF | |
30753 | SUBROUTINE PHO_SETPDF(IDPDG,ITYP,IPAR,ISET,IEXT,IPAVAL,MODE) | |
30754 | C*************************************************************** | |
30755 | C | |
30756 | C assigns PDF numbers to particles | |
30757 | C | |
30758 | C input: IDPDG PDG number of particle | |
30759 | C ITYP particle type | |
30760 | C IPAR PDF paramertization | |
30761 | C ISET number of set | |
30762 | C IEXT library number for PDF calculation | |
30763 | C IPAVAL (only output) | |
30764 | C 1 PDF with valence quarks | |
30765 | C 0 PDF without valence quarks | |
30766 | C MODE -1 add entry to table | |
30767 | C 1 read from table | |
30768 | C 2 output of table | |
30769 | C | |
30770 | C*************************************************************** | |
30771 | IMPLICIT DOUBLE PRECISION (A-H,O-Z) | |
30772 | SAVE | |
30773 | ||
30774 | C input/output channels | |
30775 | INTEGER LI,LO | |
30776 | COMMON /POINOU/ LI,LO | |
30777 | C event debugging information | |
30778 | INTEGER NMAXD | |
30779 | PARAMETER (NMAXD=100) | |
30780 | INTEGER IDEB,KSPOM,KHPOM,KSREG,KHDIR,KACCEP,KSTRG,KHTRG,KSLOO, | |
30781 | & KHLOO,KSDPO,KHDPO,KEVENT,KSOFT,KHARD | |
30782 | COMMON /PODEBG/ IDEB(NMAXD),KSPOM,KHPOM,KSREG,KHDIR,KACCEP,KSTRG, | |
30783 | & KHTRG,KSLOO,KHLOO,KSDPO,KHDPO,KEVENT,KSOFT,KHARD | |
30784 | C nucleon-nucleus / nucleus-nucleus interface to DPMJET | |
30785 | INTEGER IDEQP,IDEQB,IHFLD,IHFLS | |
30786 | DOUBLE PRECISION ECMN,PCMN,SECM,SPCM,XPSUB,XTSUB | |
30787 | COMMON /POHDFL/ ECMN,PCMN,SECM,SPCM,XPSUB,XTSUB, | |
30788 | & IDEQP(2),IDEQB(2),IHFLD(2,2),IHFLS(2) | |
30789 | ||
30790 | DIMENSION IPDFS(5,50) | |
30791 | DATA IENTRY / 0 / | |
30792 | ||
30793 | IF(MODE.EQ.1) THEN | |
30794 | I = 1 | |
30795 | IF(IDPDG.EQ.81) THEN | |
30796 | IDCMP = IDEQP(1) | |
30797 | IPAVAL = IHFLS(1) | |
30798 | ELSE IF(IDPDG.EQ.82) THEN | |
30799 | IDCMP = IDEQP(2) | |
30800 | IPAVAL = IHFLS(2) | |
30801 | ELSE | |
30802 | IDCMP = IDPDG | |
30803 | IPAVAL = 1 | |
30804 | ENDIF | |
30805 | 200 CONTINUE | |
30806 | IF(IDCMP.EQ.IPDFS(1,I)) THEN | |
30807 | ITYP = IPDFS(2,I) | |
30808 | IPAR = IPDFS(3,I) | |
30809 | ISET = IPDFS(4,I) | |
30810 | IEXT = IPDFS(5,I) | |
30811 | IF(IDEB(80).GE.15) WRITE(LO,'(1X,A,I7,5X,3I4)') | |
30812 | & 'PHO_SETPDF: ID,IPAR,ISET,IEXT',IDCMP,IPAR,ISET,IEXT | |
30813 | RETURN | |
30814 | ENDIF | |
30815 | I = I+1 | |
30816 | IF(I.GT.IENTRY) THEN | |
30817 | WRITE(LO,'(/1X,A,I7)') | |
30818 | & 'PHO_SETPDF: no PDF assigned to ',IDCMP | |
30819 | CALL PHO_ABORT | |
30820 | ENDIF | |
30821 | GOTO 200 | |
30822 | ELSE IF(MODE.EQ.-1) THEN | |
30823 | DO 50 I=1,IENTRY | |
30824 | IF(IDPDG.EQ.IPDFS(1,I)) THEN | |
30825 | WRITE(LO,'(/1X,A,5I6)') | |
30826 | & 'PHO_SETPDF: overwrite old particle PDF', | |
30827 | & IDPDG,IPDFS(2,I),IPDFS(3,I),IPDFS(4,I),IPDFS(5,I) | |
30828 | GOTO 100 | |
30829 | ENDIF | |
30830 | 50 CONTINUE | |
30831 | I = IENTRY+1 | |
30832 | IF(I.GT.50) THEN | |
30833 | WRITE(LO,'(/1X,A,/1x,6I6)') | |
30834 | & 'PHO_SETPDF:ERROR: no space left in IPDFS:', | |
30835 | & I,IDPDG,IPDFS(2,I),IPDFS(3,I),IPDFS(4,I),IPDFS(5,I) | |
30836 | STOP | |
30837 | ENDIF | |
30838 | IENTRY = I | |
30839 | 100 CONTINUE | |
30840 | IPDFS(1,I) = IDPDG | |
30841 | IF(IDPDG.EQ.990) THEN | |
30842 | ITYP1 = 20 | |
30843 | ELSE IF(IDPDG.EQ.22) THEN | |
30844 | ITYP1 = 3 | |
30845 | ELSE IF(ABS(IDPDG).LT.1000) THEN | |
30846 | ITYP1 = 2 | |
30847 | ELSE | |
30848 | ITYP1 = 1 | |
30849 | ENDIF | |
30850 | IPDFS(2,I) = ITYP1 | |
30851 | IPDFS(3,I) = IPAR | |
30852 | IPDFS(4,I) = ISET | |
30853 | IPDFS(5,I) = IEXT | |
30854 | ELSE IF(MODE.EQ.-2) THEN | |
30855 | WRITE(LO,'(/1X,A)') 'PHO_SETPDF: PDFs assigned by user:' | |
30856 | DO 150 I=1,IENTRY | |
30857 | WRITE(LO,'(5X,I4,A,I7,A,4I5)') I,' particle:',IPDFS(1,I), | |
30858 | & ' PDF-set ',IPDFS(2,I),IPDFS(3,I),IPDFS(4,I),IPDFS(5,I) | |
30859 | 150 CONTINUE | |
30860 | ELSE | |
30861 | WRITE(LO,'(/1X,A,I5)') 'PHO_SETPDF:ERROR: invalid mode ',MODE | |
30862 | ENDIF | |
30863 | END | |
30864 | ||
30865 | *$ CREATE PHO_GETPDF.FOR | |
30866 | *COPY PHO_GETPDF | |
30867 | CDECK ID>, PHO_GETPDF | |
30868 | SUBROUTINE PHO_GETPDF(NPAR,PDFNA,ALA,Q2MI,Q2MA,XMI,XMA) | |
30869 | C*************************************************************** | |
30870 | C | |
30871 | C get PDF information | |
30872 | C | |
30873 | C input: NPAR 1 first PDF in /POPPDF/ | |
30874 | C 2 second PDF in /POPPDF/ | |
30875 | C | |
30876 | C output: PDFNA name of PDf parametrization | |
30877 | C ALA QCD LAMBDA (4 flavours, in GeV) | |
30878 | C Q2MI minimal Q2 | |
30879 | C Q2MA maximal Q2 | |
30880 | C XMI minimal X | |
30881 | C XMA maximal X | |
30882 | C | |
30883 | C*************************************************************** | |
30884 | IMPLICIT DOUBLE PRECISION (A-H,O-Z) | |
30885 | SAVE | |
30886 | ||
30887 | CHARACTER*8 PDFNA | |
30888 | ||
30889 | C input/output channels | |
30890 | INTEGER LI,LO | |
30891 | COMMON /POINOU/ LI,LO | |
30892 | ||
30893 | C PHOLIB 4.15 common | |
30894 | COMMON /W50512/ QCDL4,QCDL5 | |
30895 | COMMON /W50513/ XMIN,XMAX,Q2MIN,Q2MAX | |
30896 | ||
30897 | C PHOPDF version 2.0 common | |
30898 | PARAMETER (MAXS=6,MAXP=10) | |
30899 | CHARACTER*4 CHPAR | |
30900 | COMMON/PHCOM1/ XLIM(MAXP,0:MAXS,2), Q2LIM(MAXP,0:MAXS,2), | |
30901 | & NSET(MAXP,2),NFL(MAXP) | |
30902 | COMMON/PHCOM2/ ALM(MAXP,0:MAXS),CHPAR(MAXP),IORD(MAXP,-MAXS:MAXS) | |
30903 | ||
30904 | C currently activated parton density parametrizations | |
30905 | CHARACTER*8 PDFNAM | |
30906 | INTEGER IPARID,IPAVA,ITYPE,IGRP,ISET,IEXT,NPAOLD | |
30907 | DOUBLE PRECISION PDFLAM,PDFQ2M | |
30908 | COMMON /POPPDF/ PDFLAM(2),PDFQ2M(2),PDFNAM(2),IPARID(2), | |
30909 | & IPAVA(2),ITYPE(2),IGRP(2),ISET(2),IEXT(2),NPAOLD | |
30910 | ||
30911 | DIMENSION PARAM(20),VALUE(20) | |
30912 | CHARACTER*20 PARAM | |
30913 | ||
30914 | IF((NPAR.NE.1).AND.(NPAR.NE.2)) THEN | |
30915 | WRITE(LO,'(/1X,A,I6)') | |
30916 | & 'PHO_GETPDF:ERROR: invalid PDF number (1,2)',NPAR | |
30917 | CALL PHO_ABORT | |
30918 | ENDIF | |
30919 | ALA = 0.D0 | |
30920 | ||
30921 | IF(IEXT(NPAR).EQ.0) THEN | |
30922 | ||
30923 | C internal parametrizations | |
30924 | ||
30925 | IF(ITYPE(NPAR).EQ.1) THEN | |
30926 | C proton PDFs | |
30927 | IF(IGRP(NPAR).EQ.5) THEN | |
30928 | IF(ISET(NPAR).EQ.3) THEN | |
30929 | ALA = 0.2D0 | |
30930 | Q2MI = 0.3D0 | |
30931 | PDFNA = 'GRV92 HO' | |
30932 | ELSE IF(ISET(NPAR).EQ.4) THEN | |
30933 | ALA = 0.2D0 | |
30934 | Q2MI = 0.25D0 | |
30935 | PDFNA = 'GRV92 LO' | |
30936 | ELSE IF(ISET(NPAR).EQ.5) THEN | |
30937 | ALA = 0.2D0 | |
30938 | Q2MI = 0.4D0 | |
30939 | PDFNA = 'GRV94 HO' | |
30940 | ELSE IF(ISET(NPAR).EQ.6) THEN | |
30941 | ALA = 0.2D0 | |
30942 | Q2MI = 0.4D0 | |
30943 | PDFNA = 'GRV94 LO' | |
30944 | ELSE IF(ISET(NPAR).EQ.7) THEN | |
30945 | ALA = 0.2D0 | |
30946 | Q2MI = 0.4D0 | |
30947 | PDFNA = 'GRV94 DI' | |
30948 | ELSE IF(ISET(NPAR).EQ.8) THEN | |
30949 | ALA = 0.175D0 | |
30950 | Q2MI = 0.8D0 | |
30951 | PDFNA = 'GRV98 LO' | |
30952 | ELSE IF(ISET(NPAR).EQ.9) THEN | |
30953 | ALA = 0.175D0 | |
30954 | Q2MI = 0.8D0 | |
30955 | PDFNA = 'GRV98 SC' | |
30956 | ENDIF | |
30957 | ENDIF | |
30958 | ELSE IF(ITYPE(NPAR).EQ.2) THEN | |
30959 | C pion PDFs | |
30960 | IF(IGRP(NPAR).EQ.5) THEN | |
30961 | IF(ISET(NPAR).EQ.1) THEN | |
30962 | ALA = 0.2D0 | |
30963 | Q2MI = 0.3D0 | |
30964 | PDFNA = 'GRV-P HO' | |
30965 | ELSE IF(ISET(NPAR).EQ.2) THEN | |
30966 | ALA = 0.2D0 | |
30967 | Q2MI = 0.25D0 | |
30968 | PDFNA = 'GRV-P LO' | |
30969 | ENDIF | |
30970 | ENDIF | |
30971 | ELSE IF(ITYPE(NPAR).EQ.3) THEN | |
30972 | C photon PDFs | |
30973 | IF(IGRP(NPAR).EQ.5) THEN | |
30974 | IF(ISET(NPAR).EQ.1) THEN | |
30975 | ALA = 0.2D0 | |
30976 | Q2MI = 0.3D0 | |
30977 | PDFNA = 'GRV-G LH' | |
30978 | ELSE IF(ISET(NPAR).EQ.2) THEN | |
30979 | ALA = 0.2D0 | |
30980 | Q2MI = 0.3D0 | |
30981 | PDFNA = 'GRV-G HO' | |
30982 | ELSE IF(ISET(NPAR).EQ.3) THEN | |
30983 | ALA = 0.2D0 | |
30984 | Q2MI = 0.25D0 | |
30985 | PDFNA = 'GRV-G LO' | |
30986 | ENDIF | |
30987 | ELSE IF(IGRP(NPAR).EQ.8) THEN | |
30988 | IF(ISET(NPAR).EQ.1) THEN | |
30989 | ALA = 0.2D0 | |
30990 | Q2MI = 4.D0 | |
30991 | PDFNA = 'AGL-G LO' | |
30992 | ENDIF | |
30993 | ENDIF | |
30994 | ELSE IF(ITYPE(NPAR).EQ.20) THEN | |
30995 | C pomeron PDFs | |
30996 | IF(IGRP(NPAR).EQ.4) THEN | |
30997 | CALL PHO_CKMTPA(990,XMI,XMA,ALA,Q2MI,Q2MA,PDFNA) | |
30998 | ELSE | |
30999 | ALA = 0.3D0 | |
31000 | Q2MI = 2.D0 | |
31001 | PDFNA = 'POM-PDF1' | |
31002 | ENDIF | |
31003 | ENDIF | |
31004 | ||
31005 | C external parametrizations | |
31006 | ||
31007 | ELSE IF(IEXT(NPAR).EQ.1) THEN | |
31008 | C PDFLIB call: old numbering | |
31009 | PARAM(1) = 'MODE' | |
31010 | PARAM(2) = ' ' | |
31011 | VALUE(1) = IGRP(NPAR) | |
31012 | CALL PDFSET(PARAM,VALUE) | |
31013 | Q2MI = Q2MIN | |
31014 | Q2MA = Q2MAX | |
31015 | XMI = XMIN | |
31016 | XMA = XMAX | |
31017 | ALA = QCDL4 | |
31018 | PDFNA = 'PDFLIB1' | |
31019 | ELSE IF(IEXT(NPAR).EQ.2) THEN | |
31020 | C PDFLIB call: new numbering | |
31021 | PARAM(1) = 'NPTYPE' | |
31022 | PARAM(2) = 'NGROUP' | |
31023 | PARAM(3) = 'NSET' | |
31024 | PARAM(4) = ' ' | |
31025 | VALUE(1) = ITYPE(NPAR) | |
31026 | VALUE(2) = IGRP(NPAR) | |
31027 | VALUE(3) = ISET(NPAR) | |
31028 | CALL PDFSET(PARAM,VALUE) | |
31029 | Q2MI = Q2MIN | |
31030 | Q2MA = Q2MAX | |
31031 | XMI = XMIN | |
31032 | XMA = XMAX | |
31033 | ALA = QCDL4 | |
31034 | PDFNA = 'PDFLIB2' | |
31035 | ELSE IF(IEXT(NPAR).EQ.3) THEN | |
31036 | C PHOLIB interface | |
31037 | ALA = ALM(IGRP(NPAR),ISET(NPAR)) | |
31038 | Q2MI = 2.D0 | |
31039 | PDFNA = CHPAR(IGRP(NPAR)) | |
31040 | ||
31041 | C some special internal parametrizations | |
31042 | ||
31043 | ELSE IF(IEXT(NPAR).EQ.4) THEN | |
31044 | C photon PDFs depending on virtualities | |
31045 | IF(IGRP(NPAR).EQ.1) THEN | |
31046 | C Schuler/Sjostrand parametrization | |
31047 | ALA = 0.2D0 | |
31048 | IF(ISET(NPAR).EQ.1) THEN | |
31049 | Q2MI = 0.2D0 | |
31050 | PDFNA = 'SaS-1D ' | |
31051 | ELSE IF(ISET(NPAR).EQ.2) THEN | |
31052 | Q2MI = 0.2D0 | |
31053 | PDFNA = 'SaS-1M ' | |
31054 | ELSE IF(ISET(NPAR).EQ.3) THEN | |
31055 | Q2MI = 2.D0 | |
31056 | PDFNA = 'SaS-2D ' | |
31057 | ELSE IF(ISET(NPAR).EQ.4) THEN | |
31058 | Q2MI = 2.D0 | |
31059 | PDFNA = 'SaS-2M ' | |
31060 | ENDIF | |
31061 | ELSE IF(IGRP(NPAR).EQ.5) THEN | |
31062 | C Gluck/Reya/Stratmann parametrization | |
31063 | IF(ISET(NPAR).EQ.4) THEN | |
31064 | ALA = 0.2D0 | |
31065 | Q2MI = 0.6D0 | |
31066 | PDFNA = 'GRS-G LO' | |
31067 | ENDIF | |
31068 | ENDIF | |
31069 | ELSE IF(IEXT(NPAR).EQ.5) THEN | |
31070 | C Schuler/Sjostrand anomalous only | |
31071 | ALA = 0.2D0 | |
31072 | Q2MI = 0.2D0 | |
31073 | PDFNA = 'SaS anom' | |
31074 | ENDIF | |
31075 | IF(ALA.LT.0.01D0) THEN | |
31076 | WRITE(LO,'(/1X,2A,/10X,5I6)') | |
31077 | & 'PHO_GETPDF:ERROR: ', | |
31078 | & 'unsupported PDF (NPAR,IEXT,ITYPE,IGRP,ISET)', | |
31079 | & NPAR,IEXT(NPAR),ITYPE(NPAR),IGRP(NPAR),ISET(NPAR) | |
31080 | CALL PHO_ABORT | |
31081 | ENDIF | |
31082 | ||
31083 | END | |
31084 | ||
31085 | *$ CREATE PHO_ACTPDF.FOR | |
31086 | *COPY PHO_ACTPDF | |
31087 | CDECK ID>, PHO_ACTPDF | |
31088 | SUBROUTINE PHO_ACTPDF(IDPDG,K) | |
31089 | C*************************************************************** | |
31090 | C | |
31091 | C activate PDF for QCD calculations | |
31092 | C | |
31093 | C input: IDPDG PDG particle number | |
31094 | C K 1 first PDF in /POPPDF/ | |
31095 | C 2 second PDF in /POPPDF/ | |
31096 | C -2 write current settings | |
31097 | C | |
31098 | C output: /POPPDF/ | |
31099 | C | |
31100 | C*************************************************************** | |
31101 | IMPLICIT DOUBLE PRECISION (A-H,O-Z) | |
31102 | SAVE | |
31103 | ||
31104 | C input/output channels | |
31105 | INTEGER LI,LO | |
31106 | COMMON /POINOU/ LI,LO | |
31107 | C event debugging information | |
31108 | INTEGER NMAXD | |
31109 | PARAMETER (NMAXD=100) | |
31110 | INTEGER IDEB,KSPOM,KHPOM,KSREG,KHDIR,KACCEP,KSTRG,KHTRG,KSLOO, | |
31111 | & KHLOO,KSDPO,KHDPO,KEVENT,KSOFT,KHARD | |
31112 | COMMON /PODEBG/ IDEB(NMAXD),KSPOM,KHPOM,KSREG,KHDIR,KACCEP,KSTRG, | |
31113 | & KHTRG,KSLOO,KHLOO,KSDPO,KHDPO,KEVENT,KSOFT,KHARD | |
31114 | C currently activated parton density parametrizations | |
31115 | CHARACTER*8 PDFNAM | |
31116 | INTEGER IPARID,IPAVA,ITYPE,IGRP,ISET,IEXT,NPAOLD | |
31117 | DOUBLE PRECISION PDFLAM,PDFQ2M | |
31118 | COMMON /POPPDF/ PDFLAM(2),PDFQ2M(2),PDFNAM(2),IPARID(2), | |
31119 | & IPAVA(2),ITYPE(2),IGRP(2),ISET(2),IEXT(2),NPAOLD | |
31120 | ||
31121 | IF(K.GT.0) THEN | |
31122 | ||
31123 | C read PDF from table | |
31124 | CALL PHO_SETPDF(IDPDG,ITYPE(K),IGRP(K),ISET(K),IEXT(K), | |
31125 | & IPAVA(K),1) | |
31126 | IPARID(K) = IDPDG | |
31127 | C get PDF parameters | |
31128 | CALL PHO_GETPDF(K,PDFNAM(K),PDFLAM(K),PDFQ2M(K),Q2MA,XMI,XMA) | |
31129 | C initialize alpha_s calculation | |
31130 | alam2 = PDFLAM(K)*PDFLAM(K) | |
31131 | DUMMY = PHO_ALPHAS(alam2,-K) | |
31132 | ||
31133 | IF(IDEB(2).GE.20) THEN | |
31134 | WRITE(LO,'(1X,A)') | |
31135 | & 'PHO_ACTPDF: LAMBDA,Q2MIN,NAME,ITYPE,IPAR,ISET,IEXT,PAR' | |
31136 | WRITE(LO,'(1X,A,I2,2E12.3,2X,A8,4I4,I7)') 'SIDE',K, | |
31137 | & PDFLAM(K),PDFQ2M(K),PDFNAM(K),ITYPE(K),IGRP(K),ISET(K), | |
31138 | & IEXT(K),IPARID(K) | |
31139 | ENDIF | |
31140 | NPAOLD = K | |
31141 | ||
31142 | ELSE IF(K.EQ.-2) THEN | |
31143 | ||
31144 | C write table of current PDFs | |
31145 | WRITE(LO,'(1X,A)') | |
31146 | & 'PHO_ACTPDF: LAMBDA,Q2MIN,NAME,ITYPE,IPAR,ISET,IEXT,PAR' | |
31147 | WRITE(LO,'(1X,A,2E12.3,2X,A8,4I4,I7)') 'SIDE 1:',PDFLAM(1), | |
31148 | & PDFQ2M(1),PDFNAM(1),ITYPE(1),IGRP(1),ISET(1),IEXT(1), | |
31149 | & IPARID(1) | |
31150 | WRITE(LO,'(1X,A,2E12.3,2X,A8,4I4,I7)') 'SIDE 2:',PDFLAM(2), | |
31151 | & PDFQ2M(2),PDFNAM(2),ITYPE(2),IGRP(2),ISET(2),IEXT(2), | |
31152 | & IPARID(2) | |
31153 | ||
31154 | ELSE | |
31155 | ||
31156 | WRITE(LO,'(/1X,A,2I4)') | |
31157 | & 'PHO_ACTPDF:ERROR: invalid arguments',IDPDG,K | |
31158 | CALL PHO_ABORT | |
31159 | ||
31160 | ENDIF | |
31161 | ||
31162 | END | |
31163 | ||
31164 | *$ CREATE PHO_PDFTST.FOR | |
31165 | *COPY PHO_PDFTST | |
31166 | CDECK ID>, PHO_PDFTST | |
31167 | SUBROUTINE PHO_PDFTST(IDPDG,SCALE2,P2MASS) | |
31168 | C********************************************************************* | |
31169 | C | |
31170 | C structure function test utility | |
31171 | C | |
31172 | C input: IDPDG PDG ID of particle | |
31173 | C SCALE2 squared scale (GeV**2) | |
31174 | C P2MASS particle virtuality (pos, GeV**2) | |
31175 | C | |
31176 | C output: tables of PDF, sum rule checking, table of F2 | |
31177 | C | |
31178 | C********************************************************************* | |
31179 | IMPLICIT DOUBLE PRECISION (A-H,O-Z) | |
31180 | SAVE | |
31181 | ||
31182 | C input/output channels | |
31183 | INTEGER LI,LO | |
31184 | COMMON /POINOU/ LI,LO | |
31185 | C currently activated parton density parametrizations | |
31186 | CHARACTER*8 PDFNAM | |
31187 | INTEGER IPARID,IPAVA,ITYPE,IGRP,ISET,IEXT,NPAOLD | |
31188 | DOUBLE PRECISION PDFLAM,PDFQ2M | |
31189 | COMMON /POPPDF/ PDFLAM(2),PDFQ2M(2),PDFNAM(2),IPARID(2), | |
31190 | & IPAVA(2),ITYPE(2),IGRP(2),ISET(2),IEXT(2),NPAOLD | |
31191 | C some constants | |
31192 | DOUBLE PRECISION PI,PI2,PI4,GEV2MB,Q_ch,Q_ch2,Q_ch4 | |
31193 | COMMON /POCONS/ PI,PI2,PI4,GEV2MB, | |
31194 | & Q_ch(-6:6),Q_ch2(-6:6),Q_ch4(-6:6) | |
31195 | ||
31196 | DIMENSION PD(-6:6),PDSUM(-6:6),PDAVE(-6:6),FXP(4) | |
31197 | CHARACTER*8 PDFNA | |
31198 | ||
31199 | CALL PHO_ACTPDF(IDPDG,1) | |
31200 | CALL PHO_GETPDF(1,PDFNA,ALA,Q2MI,Q2MA,XMI,XMA) | |
31201 | ||
31202 | WRITE(LO,'(/,A)') ' *** Structure Function Test Utility ***' | |
31203 | WRITE(LO,'(A)') ' =======================================' | |
31204 | ||
31205 | WRITE(LO,'(/,A,3I10)') | |
31206 | & ' used structure function:',ITYPE(1),IGRP(1),ISET(1) | |
31207 | WRITE(LO,'(A,A)') ' corresponds to ',PDFNA | |
31208 | WRITE(LO,'(A,E12.3)') ' used squared scale (GeV**2):',SCALE2 | |
31209 | WRITE(LO,'(A,E12.3)') ' particle virtuality (GeV**2):',P2MASS | |
31210 | WRITE(LO,'(/1X,A)') 'x times parton densities' | |
31211 | WRITE(LO,'(1X,A)') ' X PD(-4 - 4)' | |
31212 | WRITE(LO,'(1X,A)') | |
31213 | & ' ============================================================' | |
31214 | ||
31215 | C logarithmic loop over x values | |
31216 | C upper bound | |
31217 | XUPPER=0.9999D0 | |
31218 | C lower bound | |
31219 | XLOWER=1.D-4 | |
31220 | C number of steps | |
31221 | NSTEP=50 | |
31222 | ||
31223 | XFIRST=LOG(XLOWER) | |
31224 | XDELTA=LOG(XUPPER/XLOWER)/DBLE(NSTEP-1) | |
31225 | DO 100 I=1,NSTEP | |
31226 | X=EXP(XFIRST) | |
31227 | XCONTR=X | |
31228 | CALL PHO_PDF(1,X,SCALE2,P2MASS,PD) | |
31229 | IF(X.NE.XCONTR) THEN | |
31230 | WRITE(LO,*) ' x changed! old: ',XCONTR,' new: ',X | |
31231 | ENDIF | |
31232 | WRITE(LO,'(1X,1P,10E11.4)') XCONTR,(PD(K),K=-4,4) | |
31233 | XFIRST=XFIRST+XDELTA | |
31234 | 100 CONTINUE | |
31235 | ||
31236 | IF(IDPDG.EQ.22) THEN | |
31237 | WRITE(LO,'(/1X,A)') | |
31238 | & 'comparison PDF to contribution due to box diagram' | |
31239 | WRITE(LO,'(1X,A)') ' X PD(1),PB(1), .... ,PD(4),PB(4)' | |
31240 | WRITE(LO,'(1X,A)') | |
31241 | & ' ============================================================' | |
31242 | XFIRST=LOG(XLOWER) | |
31243 | XDELTA=LOG(XUPPER/XLOWER)/DBLE(NSTEP-1) | |
31244 | DO 110 I=1,NSTEP | |
31245 | X=EXP(XFIRST) | |
31246 | CALL PHO_PDF(1,X,SCALE2,P2MASS,PD) | |
31247 | DO 120 K=1,4 | |
31248 | CALL PHO_QPMPDF(K,X,SCALE2,0.D0,P2MASS,FXP(K)) | |
31249 | 120 CONTINUE | |
31250 | WRITE(LO,'(1X,1P,9E11.4)') X,(PD(K),FXP(K),K=1,4) | |
31251 | XFIRST=XFIRST+XDELTA | |
31252 | 110 CONTINUE | |
31253 | ENDIF | |
31254 | ||
31255 | C check momentum sum rule | |
31256 | ||
31257 | WRITE(LO,'(/1X,A)') 'PHO_PDFTST: estimate of quark sum rules' | |
31258 | DO 199 I=-6,6 | |
31259 | PDSUM(I) = 0.D0 | |
31260 | PDAVE(I) = 0.D0 | |
31261 | 199 CONTINUE | |
31262 | ITER=5000 | |
31263 | DO 200 I=1,ITER | |
31264 | XX=DBLE(I)/DBLE(ITER) | |
31265 | IF(XX.EQ.1.D0) XX = 0.999999D0 | |
31266 | CALL PHO_PDF(1,XX,SCALE2,P2MASS,PD) | |
31267 | DO 202 K=-6,6 | |
31268 | PDSUM(K) = PDSUM(K)+PD(K)/XX | |
31269 | PDAVE(K) = PDAVE(K)+PD(K) | |
31270 | 202 CONTINUE | |
31271 | 200 CONTINUE | |
31272 | WRITE(LO,'(1X,A)') | |
31273 | & 'Table: parton-ID, dx-integral over Q(X,Q**2), X*Q(X,Q**2)' | |
31274 | XSUM = 0.D0 | |
31275 | DO 204 I=-6,6 | |
31276 | PDSUM(I) = PDSUM(I)/DBLE(ITER) | |
31277 | PDAVE(I) = PDAVE(I)/DBLE(ITER) | |
31278 | XSUM = XSUM+PDAVE(I) | |
31279 | WRITE(LO,'(9X,I3,3X,2E15.4)') I,PDSUM(I),PDAVE(I) | |
31280 | 204 CONTINUE | |
31281 | WRITE(LO,'(1X,A)') 'PHO_PDFTST: valence flavours' | |
31282 | DO 205 I=1,6 | |
31283 | WRITE(LO,'(9X,I3,E12.4)') I,PDSUM(I)-PDSUM(-I) | |
31284 | 205 CONTINUE | |
31285 | WRITE(LO,'(1X,A,E12.4)') 'momentum sum rule',XSUM | |
31286 | WRITE(LO,'(A/)') ' =============================================' | |
31287 | ||
31288 | C table of F2 | |
31289 | ||
31290 | WRITE(LO,'(/1X,A,E12.4,/1X,A)') | |
31291 | & 'PHO_PDFTST: TABLE OF X, F2(X,Q**2) FOR Q**2',SCALE2, | |
31292 | & '-----------------------------------------------------' | |
31293 | ITER=100 | |
31294 | DO 300 I=1,ITER | |
31295 | XX=DBLE(I)/DBLE(ITER) | |
31296 | IF(XX.EQ.1.D0) XX = 0.9999D0 | |
31297 | CALL PHO_PDF(1,XX,SCALE2,P2MASS,PD) | |
31298 | F2 = 0.D0 | |
31299 | DO 302 K=-6,6 | |
31300 | IF(K.NE.0) F2 = F2 + Q_ch2(K)*PD(K) | |
31301 | 302 CONTINUE | |
31302 | WRITE(LO,'(5X,1P,2E14.5)') XX,F2 | |
31303 | 300 CONTINUE | |
31304 | WRITE(LO,'(A/)') ' =============================================' | |
31305 | END | |
31306 | ||
31307 | *$ CREATE PHO_REGPAR.FOR | |
31308 | *COPY PHO_REGPAR | |
31309 | CDECK ID>, PHO_REGPAR | |
31310 | SUBROUTINE PHO_REGPAR(ISTH,IDPDG,IDBAM,JM1,JM2,P1,P2,P3,P4, | |
31311 | & IPHIS1,IPHIS2,IC1,IC2,IPOS,IMODE) | |
31312 | C********************************************************************** | |
31313 | C | |
31314 | C registration of particle in /POEVT1/ and /POEVT2/ | |
31315 | C | |
31316 | C input: ISTH status code of particle | |
31317 | C -2 initial parton hard scattering | |
31318 | C -1 parton | |
31319 | C 0 string | |
31320 | C 1 visible particle (no color) | |
31321 | C 2 decayed particle | |
31322 | C IDPDG PDG particle ID code | |
31323 | C IDBAM CPC particle ID code | |
31324 | C JM1,JM2 first and second mother index | |
31325 | C P1..P4 four momentum | |
31326 | C IPHIS1 extended history information | |
31327 | C IPHIS1<100: JM1 from particle 1 | |
31328 | C IPHIS1>100: JM1 from particle 2 | |
31329 | C 1 valence quark | |
31330 | C 2 valence diquark | |
31331 | C 3 sea quark | |
31332 | C 4 sea diquark | |
31333 | C (neg. for antipartons) | |
31334 | C IPHIS2 extended history information | |
31335 | C positive: JM2 from particle 1 | |
31336 | C negative: JM2 from particle 2 | |
31337 | C (see IPHIS1) | |
31338 | C IC1,IC2 color labels for partons | |
31339 | C IMODE 1 register given parton | |
31340 | C 0 reset /POEVT1/ and /POEVT2/ | |
31341 | C 2 return data of entry IPOS | |
31342 | C | |
31343 | C IPOS position of particle in /POEVT1/ | |
31344 | C | |
31345 | C********************************************************************** | |
31346 | IMPLICIT DOUBLE PRECISION (A-H,O-Z) | |
31347 | SAVE | |
31348 | ||
31349 | PARAMETER (DEPS = 1.D-20) | |
31350 | ||
31351 | C input/output channels | |
31352 | INTEGER LI,LO | |
31353 | COMMON /POINOU/ LI,LO | |
31354 | C event debugging information | |
31355 | INTEGER NMAXD | |
31356 | PARAMETER (NMAXD=100) | |
31357 | INTEGER IDEB,KSPOM,KHPOM,KSREG,KHDIR,KACCEP,KSTRG,KHTRG,KSLOO, | |
31358 | & KHLOO,KSDPO,KHDPO,KEVENT,KSOFT,KHARD | |
31359 | COMMON /PODEBG/ IDEB(NMAXD),KSPOM,KHPOM,KSREG,KHDIR,KACCEP,KSTRG, | |
31360 | & KHTRG,KSLOO,KHLOO,KSDPO,KHDPO,KEVENT,KSOFT,KHARD | |
31361 | C standard particle data interface | |
31362 | INTEGER NMXHEP | |
31363 | PARAMETER (NMXHEP=4000) | |
31364 | INTEGER NEVHEP,NHEP,ISTHEP,IDHEP,JMOHEP,JDAHEP | |
31365 | DOUBLE PRECISION PHEP,VHEP | |
31366 | COMMON /POEVT1/ NEVHEP,NHEP,ISTHEP(NMXHEP),IDHEP(NMXHEP), | |
31367 | & JMOHEP(2,NMXHEP),JDAHEP(2,NMXHEP),PHEP(5,NMXHEP), | |
31368 | & VHEP(4,NMXHEP) | |
31369 | C extension to standard particle data interface (PHOJET specific) | |
31370 | INTEGER IMPART,IPHIST,ICOLOR | |
31371 | COMMON /POEVT2/ IMPART(NMXHEP),IPHIST(2,NMXHEP),ICOLOR(2,NMXHEP) | |
31372 | ||
31373 | IF(IMODE.EQ.1) THEN | |
31374 | IF(IDEB(76).GE.26) THEN | |
31375 | WRITE(LO,'(1X,A,/2X,I3,I6,3I4,4E10.3)') | |
31376 | & 'PHO_REGPAR: ISTH,IDPDG,IDBAM,JM1,JM2,P1,P2,P3,P4', | |
31377 | & ISTH,IDPDG,IDBAM,JM1,JM2,P1,P2,P3,P4 | |
31378 | WRITE(LO,'(1X,A,/2X,6I6)') | |
31379 | & 'PHO_REGPAR: IPHIS1,IPHIS2,IC1,IC2,IPOS,IMODE', | |
31380 | & IPHIS1,IPHIS2,IC1,IC2,IPOS,IMODE | |
31381 | ENDIF | |
31382 | IF(NHEP.EQ.NMXHEP) THEN | |
31383 | WRITE(LO,'(/1X,2A,2I6/)') 'PHO_REGPAR: ', | |
31384 | & 'no space left in /POEVT1/ (NHEP,NMXHEP):',NHEP,NMXHEP | |
31385 | CALL PHO_ABORT | |
31386 | ENDIF | |
31387 | NHEP = NHEP+1 | |
31388 | IDBAMI = IDBAM | |
31389 | IDPDGI = IDPDG | |
31390 | IF(ABS(ISTH).LE.2) THEN | |
31391 | IF((IDBAM.NE.0).AND.(IDPDG.EQ.0)) THEN | |
31392 | IDPDGI = ipho_id2pdg(IDBAM) | |
31393 | ELSE IF((IDBAM.EQ.0).AND.(IDPDG.NE.0)) THEN | |
31394 | IDBAMI = ipho_pdg2id(IDPDG) | |
31395 | ENDIF | |
31396 | ENDIF | |
31397 | C standard data | |
31398 | ISTHEP(NHEP) = ISTH | |
31399 | IDHEP(NHEP) = IDPDGI | |
31400 | JMOHEP(1,NHEP) = JM1 | |
31401 | JMOHEP(2,NHEP) = JM2 | |
31402 | C update of mother-daugther relations | |
31403 | IF(ABS(ISTH).LE.1) THEN | |
31404 | IF(JM1.GT.0) THEN | |
31405 | IF(JDAHEP(1,JM1).EQ.0) THEN | |
31406 | JDAHEP(1,JM1) = NHEP | |
31407 | ISTHEP(JM1) = 2 | |
31408 | ENDIF | |
31409 | JDAHEP(2,JM1) = NHEP | |
31410 | ENDIF | |
31411 | IF((JM2.NE.JM1).AND.(JM2.GT.0)) THEN | |
31412 | IF(JDAHEP(1,JM2).EQ.0) THEN | |
31413 | JDAHEP(1,JM2) = NHEP | |
31414 | ISTHEP(JM2) = 2 | |
31415 | ENDIF | |
31416 | JDAHEP(2,JM2) = NHEP | |
31417 | ELSE IF(JM2.LT.0) THEN | |
31418 | DO 100 II=JM1+1,-JM2 | |
31419 | IF(JDAHEP(1,II).EQ.0) THEN | |
31420 | JDAHEP(1,II) = NHEP | |
31421 | ISTHEP(II) = 2 | |
31422 | ENDIF | |
31423 | JDAHEP(2,II) = NHEP | |
31424 | 100 CONTINUE | |
31425 | ENDIF | |
31426 | ENDIF | |
31427 | PHEP(1,NHEP) = P1 | |
31428 | PHEP(2,NHEP) = P2 | |
31429 | PHEP(3,NHEP) = P3 | |
31430 | PHEP(4,NHEP) = P4 | |
31431 | IF((ABS(ISTH).LE.3).OR.(ISTH.EQ.20).OR.(ISTH.EQ.21)) THEN | |
31432 | TMP=(P4-P3)*(P4+P3)-P1**2-P2**2 | |
31433 | PHEP(5,NHEP) = SIGN(SQRT(ABS(TMP)),TMP) | |
31434 | ELSE | |
31435 | PHEP(5,NHEP) = 0.D0 | |
31436 | ENDIF | |
31437 | JDAHEP(1,NHEP) = 0 | |
31438 | JDAHEP(2,NHEP) = 0 | |
31439 | C extended information | |
31440 | IMPART(NHEP) = IDBAMI | |
31441 | C extended history information | |
31442 | IPHIST(1,NHEP) = IPHIS1 | |
31443 | IPHIST(2,NHEP) = IPHIS2 | |
31444 | C charge/baryon number or color labels | |
31445 | IF(ISTH.EQ.1) THEN | |
31446 | ICOLOR(1,NHEP) = IPHO_CHR3(NHEP,2) | |
31447 | ICOLOR(2,NHEP) = IPHO_BAR3(NHEP,2) | |
31448 | ELSE | |
31449 | ICOLOR(1,NHEP) = IC1 | |
31450 | ICOLOR(2,NHEP) = IC2 | |
31451 | ENDIF | |
31452 | ||
31453 | IPOS = NHEP | |
31454 | IF(IDEB(76).GE.26) THEN | |
31455 | WRITE(LO,'(1X,A,2I4,2X,2I4,E12.3,I5)') | |
31456 | & 'PHO_REGPAR: IPHIST1/2,IC1/2,MASS,IPOS',IPHIST(1,NHEP), | |
31457 | & IPHIST(2,NHEP),ICOLOR(1,NHEP),ICOLOR(2,NHEP), | |
31458 | & PHEP(5,NHEP),IPOS | |
31459 | ENDIF | |
31460 | ||
31461 | ELSE IF(IMODE.EQ.0) THEN | |
31462 | NHEP = 0 | |
31463 | ELSE IF(IMODE.EQ.2) THEN | |
31464 | IF((IPOS.LT.1).OR.(IPOS.GT.NHEP)) THEN | |
31465 | WRITE(LO,'(1X,2A,2I8)') 'PHO_REGPAR: ', | |
31466 | & 'index out of bounds (NHEP,IPOS)',NHEP,IPOS | |
31467 | RETURN | |
31468 | ENDIF | |
31469 | ISTH = ISTHEP(IPOS) | |
31470 | IDPDG = IDHEP(IPOS) | |
31471 | IDBAM = IMPART(IPOS) | |
31472 | JM1 = JMOHEP(1,IPOS) | |
31473 | JM2 = JMOHEP(2,IPOS) | |
31474 | P1 = PHEP(1,IPOS) | |
31475 | P2 = PHEP(2,IPOS) | |
31476 | P3 = PHEP(3,IPOS) | |
31477 | P4 = PHEP(4,IPOS) | |
31478 | IPHIS1= IPHIST(1,IPOS) | |
31479 | IPHIS2= IPHIST(2,IPOS) | |
31480 | IC1 = ICOLOR(1,IPOS) | |
31481 | IC2 = ICOLOR(2,IPOS) | |
31482 | ELSE | |
31483 | WRITE(LO,'(1X,A,I8)') 'PHO_REGPAR: invalid mode',IMODE | |
31484 | ENDIF | |
31485 | END | |
31486 | ||
31487 | *$ CREATE IPHO_CNV1.FOR | |
31488 | *COPY IPHO_CNV1 | |
31489 | CDECK ID>, IPHO_CNV1 | |
31490 | INTEGER FUNCTION IPHO_CNV1(IPART) | |
31491 | C********************************************************************* | |
31492 | C | |
31493 | C conversion of quark numbering scheme to PARTICLE DATA GROUP | |
31494 | C convention | |
31495 | C | |
31496 | C input: old internal particle code of hard scattering | |
31497 | C 0 gluon | |
31498 | C 1 d | |
31499 | C 2 u | |
31500 | C 3 s | |
31501 | C 4 c | |
31502 | C valence quarks changed to standard numbering | |
31503 | C | |
31504 | C output: standard particle codes | |
31505 | C | |
31506 | C********************************************************************* | |
31507 | IMPLICIT DOUBLE PRECISION (A-H,O-Z) | |
31508 | SAVE | |
31509 | C | |
31510 | II = ABS(IPART) | |
31511 | C change gluon number | |
31512 | IF(II.EQ.0) THEN | |
31513 | IPHO_CNV1 = 21 | |
31514 | C change valence quark | |
31515 | ELSE IF((II.GT.6).AND.(II.LT.13)) THEN | |
31516 | IPHO_CNV1 = SIGN(II-6,IPART) | |
31517 | ELSE | |
31518 | IPHO_CNV1 = IPART | |
31519 | ENDIF | |
31520 | END | |
31521 | ||
31522 | *$ CREATE PHO_HACODE.FOR | |
31523 | *COPY PHO_HACODE | |
31524 | CDECK ID>, PHO_HACODE | |
31525 | SUBROUTINE PHO_HACODE(ID1,ID2,IDcpc1,IDcpc2) | |
31526 | C********************************************************************* | |
31527 | C | |
31528 | C determination of hadron index from quarks | |
31529 | C | |
31530 | C input: ID1,ID2 parton code according to PDG conventions | |
31531 | C | |
31532 | C output: IDcpc1,2 CPC particle codes | |
31533 | C | |
31534 | C********************************************************************* | |
31535 | IMPLICIT NONE | |
31536 | SAVE | |
31537 | ||
31538 | integer ID1,ID2,IDcpc1,IDcpc2 | |
31539 | ||
31540 | C input/output channels | |
31541 | INTEGER LI,LO | |
31542 | COMMON /POINOU/ LI,LO | |
31543 | C event debugging information | |
31544 | INTEGER NMAXD | |
31545 | PARAMETER (NMAXD=100) | |
31546 | INTEGER IDEB,KSPOM,KHPOM,KSREG,KHDIR,KACCEP,KSTRG,KHTRG,KSLOO, | |
31547 | & KHLOO,KSDPO,KHDPO,KEVENT,KSOFT,KHARD | |
31548 | COMMON /PODEBG/ IDEB(NMAXD),KSPOM,KHPOM,KSREG,KHDIR,KACCEP,KSTRG, | |
31549 | & KHTRG,KSLOO,KHLOO,KSDPO,KHDPO,KEVENT,KSOFT,KHARD | |
31550 | C general particle data | |
31551 | double precision xm_list,tau_list,gam_list, | |
31552 | & xm_psm2_list,xm_vem2_list,xm_b82_list,xm_b102_list, | |
31553 | & xm_bb82_list,xm_bb102_list | |
31554 | integer ich3_list,iba3_list,iq_list, | |
31555 | & id_psm_list,id_vem_list,id_b8_list,id_b10_list | |
31556 | COMMON /POPAR2/ xm_list(300),tau_list(300),gam_list(300), | |
31557 | & xm_psm2_list(6,6),xm_vem2_list(6,6), | |
31558 | & xm_b82_list(6,6,6),xm_b102_list(6,6,6), | |
31559 | & xm_bb82_list(6,6,6,6),xm_bb102_list(6,6,6,6), | |
31560 | & ich3_list(300),iba3_list(300),iq_list(3,300), | |
31561 | & id_psm_list(6,6),id_vem_list(6,6), | |
31562 | & id_b8_list(6,6,6),id_b10_list(6,6,6) | |
31563 | ||
31564 | C local variables | |
31565 | integer ii,jj,kk,i1,i2 | |
31566 | ||
31567 | IDcpc1 = 0 | |
31568 | IDcpc2 = 0 | |
31569 | ||
31570 | if(ID1*ID2.lt.0) then | |
31571 | C meson | |
31572 | if(ID1.gt.0) then | |
31573 | ii = ID1 | |
31574 | jj = -ID2 | |
31575 | else | |
31576 | ii = ID2 | |
31577 | jj = -ID1 | |
31578 | endif | |
31579 | IDcpc1 = ID_psm_list(ii,jj) | |
31580 | IDcpc2 = ID_vem_list(ii,jj) | |
31581 | ||
31582 | else | |
31583 | C baryon | |
31584 | i1 = abs(ID1) | |
31585 | i2 = abs(ID2) | |
31586 | if(i1.gt.6) then | |
31587 | ii = i1/1000 | |
31588 | jj = (i1-ii*1000)/100 | |
31589 | kk = i2 | |
31590 | else | |
31591 | ii = i1 | |
31592 | jj = i2/1000 | |
31593 | kk = (i2-jj*1000)/100 | |
31594 | endif | |
31595 | IDcpc1 = sign(ID_b8_list(ii,jj,kk),ID1) | |
31596 | IDcpc2 = sign(ID_b10_list(ii,jj,kk),ID1) | |
31597 | ||
31598 | endif | |
31599 | ||
31600 | END | |
31601 | ||
31602 | *$ CREATE PHO_ID2STR.FOR | |
31603 | *COPY PHO_ID2STR | |
31604 | CDECK ID>, PHO_ID2STR | |
31605 | SUBROUTINE PHO_ID2STR(ID1,ID2,NOBAM,IBAM1,IBAM2,IBAM3,IBAM4) | |
31606 | C********************************************************************* | |
31607 | C | |
31608 | C conversion of quark numbering scheme | |
31609 | C | |
31610 | C input: standard particle codes: | |
31611 | C ID1 | |
31612 | C ID2 | |
31613 | C | |
31614 | C output: NOBAM CPC string code | |
31615 | C quark codes (PDG convention): | |
31616 | C IBAM1 | |
31617 | C IBAM2 | |
31618 | C IBAM3 | |
31619 | C IBAM4 | |
31620 | C | |
31621 | C NOBAM = -1 invalid flavour combinations | |
31622 | C | |
31623 | C********************************************************************* | |
31624 | IMPLICIT DOUBLE PRECISION (A-H,O-Z) | |
31625 | SAVE | |
31626 | ||
31627 | C input/output channels | |
31628 | INTEGER LI,LO | |
31629 | COMMON /POINOU/ LI,LO | |
31630 | ||
31631 | IDA1 = ABS(ID1) | |
31632 | IDA2 = ABS(ID2) | |
31633 | ||
31634 | C quark-antiquark string | |
31635 | IF((IDA1.LE.6).AND.(IDA2.LE.6)) THEN | |
31636 | IF((ID1*ID2).GE.0) GOTO 100 | |
31637 | IBAM1 = ID1 | |
31638 | IBAM2 = ID2 | |
31639 | IBAM3 = 0 | |
31640 | IBAM4 = 0 | |
31641 | NOBAM = 3 | |
31642 | C quark-diquark string | |
31643 | ELSE IF((IDA2.GT.6).AND.(IDA1.LE.6)) THEN | |
31644 | IF((ID1*ID2).LE.0) GOTO 100 | |
31645 | IBAM1 = ID1 | |
31646 | IBAM2 = ID2/1000 | |
31647 | IBAM3 = (ID2-IBAM2*1000)/100 | |
31648 | IBAM4 = 0 | |
31649 | NOBAM = 4 | |
31650 | C diquark-quark string | |
31651 | ELSE IF((IDA1.GT.6).AND.(IDA2.LE.6)) THEN | |
31652 | IF((ID1*ID2).LE.0) GOTO 100 | |
31653 | IBAM1 = ID1/1000 | |
31654 | IBAM2 = (ID1-IBAM1*1000)/100 | |
31655 | IBAM3 = ID2 | |
31656 | IBAM4 = 0 | |
31657 | NOBAM = 6 | |
31658 | C gluon-gluon string | |
31659 | ELSE IF((IDA1.EQ.21).AND.(IDA2.EQ.21)) THEN | |
31660 | IBAM1 = 21 | |
31661 | IBAM2 = 21 | |
31662 | IBAM3 = 0 | |
31663 | IBAM4 = 0 | |
31664 | NOBAM = 7 | |
31665 | C diquark-antidiquark string | |
31666 | ELSE IF((IDA1.GT.6).AND.(IDA2.GT.6)) THEN | |
31667 | IF((ID1*ID2).GE.0) GOTO 100 | |
31668 | IBAM1 = ID1/1000 | |
31669 | IBAM2 = (ID1-IBAM1*1000)/100 | |
31670 | IBAM3 = ID2/1000 | |
31671 | IBAM4 = (ID2-IBAM3*1000)/100 | |
31672 | NOBAM = 5 | |
31673 | ENDIF | |
31674 | RETURN | |
31675 | ||
31676 | C invalid combination | |
31677 | 100 CONTINUE | |
31678 | WRITE(LO,'(//1X,A,2I10)') | |
31679 | & 'PHO_ID2STR: invalid flavors for string (ID1,ID2)',ID1,ID2 | |
31680 | CALL PHO_ABORT | |
31681 | ||
31682 | END | |
31683 | ||
31684 | *$ CREATE PHO_MKSLTR.FOR | |
31685 | *COPY PHO_MKSLTR | |
31686 | CDECK ID>, PHO_MKSLTR | |
31687 | SUBROUTINE PHO_MKSLTR(P1,P2,GAM,GAMB) | |
31688 | C******************************************************************** | |
31689 | C | |
31690 | C calculate successive Lorentz boots for arbitrary Lorentz trans. | |
31691 | C | |
31692 | C input: P1 initial 4 vector | |
31693 | C GAM(3),GAMB(3) Lorentz boost parameters | |
31694 | C | |
31695 | C output: P2 final 4 vector | |
31696 | C | |
31697 | C******************************************************************** | |
31698 | IMPLICIT DOUBLE PRECISION (A-H,O-Z) | |
31699 | SAVE | |
31700 | ||
31701 | DIMENSION P1(4),P2(4),GAM(3),GAMB(3) | |
31702 | ||
31703 | P2(4) = P1(4) | |
31704 | DO 150 I=1,3 | |
31705 | P2(I)=GAM(I)*P1(I)+GAMB(I)*P2(4) | |
31706 | P2(4)=GAM(I)*P2(4)+GAMB(I)*P1(I) | |
31707 | 150 CONTINUE | |
31708 | END | |
31709 | ||
31710 | *$ CREATE PHO_GETLTR.FOR | |
31711 | *COPY PHO_GETLTR | |
31712 | CDECK ID>, PHO_GETLTR | |
31713 | SUBROUTINE PHO_GETLTR(P1,P2,GAM,GAMB,DELE,IREJ) | |
31714 | C******************************************************************** | |
31715 | C | |
31716 | C calculate Lorentz boots for arbitrary Lorentz transformation | |
31717 | C | |
31718 | C input: P1 initial 4 vector | |
31719 | C P2 final 4 vector | |
31720 | C | |
31721 | C output: GAM(3),GAMB(3) | |
31722 | C DELE energy deviation | |
31723 | C IREJ 0 success | |
31724 | C 1 failure | |
31725 | C | |
31726 | C******************************************************************** | |
31727 | IMPLICIT DOUBLE PRECISION (A-H,O-Z) | |
31728 | SAVE | |
31729 | ||
31730 | PARAMETER ( DREL = 0.001D0 ) | |
31731 | ||
31732 | C input/output channels | |
31733 | INTEGER LI,LO | |
31734 | COMMON /POINOU/ LI,LO | |
31735 | ||
31736 | DIMENSION P1(4),P2(4),GAM(3),GAMB(3),PA(4),PP(4) | |
31737 | ||
31738 | IREJ = 1 | |
31739 | DO 50 K=1,4 | |
31740 | PA(K) = P1(K) | |
31741 | PP(K) = P1(K) | |
31742 | 50 CONTINUE | |
31743 | PM1 = P1(4)**2-P1(1)**2-P1(2)**2-P1(3)**2 | |
31744 | DO 100 I=1,3 | |
31745 | PP(I) = P2(I) | |
31746 | PP(4) = PM1+PP(1)**2+PP(2)**2+PP(3)**2 | |
31747 | IF(PP(4).LE.0.D0) RETURN | |
31748 | PP(4) = SQRT(PP(4)) | |
31749 | GAMB(I) = (SQRT(PA(4)**2-PA(I)**2+PP(I)**2)*PP(I) | |
31750 | & -PA(4)*PA(I))/(PA(4)**2+PP(I)**2) | |
31751 | GAM(I) = 1.D0/SQRT(1.D0-GAMB(I)**2) | |
31752 | GAMB(I) = GAMB(I)*GAM(I) | |
31753 | DO 150 K=1,4 | |
31754 | PA(K) = PP(K) | |
31755 | 150 CONTINUE | |
31756 | 100 CONTINUE | |
31757 | DELE = P2(4)-PP(4) | |
31758 | IREJ = 0 | |
31759 | C consistency check | |
31760 | * IF(ABS(P2(4)-PP(4))/MAX(P2(4),PP(4)).GT.DREL) THEN | |
31761 | * PM2 = P2(4)**2-P2(1)**2-P2(2)**2-P2(3)**2 | |
31762 | * WRITE(LO,'(/1X,A,2E12.5)') | |
31763 | * & 'PHO_GETLTR: INCONSISTENT ENERGIES',P2(4),PP(4) | |
31764 | * WRITE(LO,'(1X,A,2E12.4)') 'INPUT MASSES',PM1,PM2 | |
31765 | * WRITE(LO,'(1X,A,4E12.4)') 'INPUT ',P1 | |
31766 | * WRITE(LO,'(1X,A,4E12.4)') 'OUTPUT',P2 | |
31767 | * WRITE(LO,'(1X,A,4E12.4)') 'INTERN',PP | |
31768 | * ENDIF | |
31769 | END | |
31770 | ||
31771 | *$ CREATE PHO_ALTRA.FOR | |
31772 | *COPY PHO_ALTRA | |
31773 | CDECK ID>, PHO_ALTRA | |
31774 | SUBROUTINE PHO_ALTRA(GA,BGX,BGY,BGZ,PCX,PCY,PCZ,EC,P,PX,PY,PZ,E) | |
31775 | C********************************************************************* | |
31776 | C | |
31777 | C arbitrary Lorentz transformation | |
31778 | C | |
31779 | C********************************************************************* | |
31780 | IMPLICIT DOUBLE PRECISION (A-H,O-Z) | |
31781 | SAVE | |
31782 | ||
31783 | EP=PCX*BGX+PCY*BGY+PCZ*BGZ | |
31784 | PE=EP/(GA+1.D0)+EC | |
31785 | PX=PCX+BGX*PE | |
31786 | PY=PCY+BGY*PE | |
31787 | PZ=PCZ+BGZ*PE | |
31788 | P=SQRT(PX*PX+PY*PY+PZ*PZ) | |
31789 | E=GA*EC+EP | |
31790 | ||
31791 | END | |
31792 | ||
31793 | *$ CREATE PHO_LTRANS.FOR | |
31794 | *COPY PHO_LTRANS | |
31795 | CDECK ID>, PHO_LTRANS | |
31796 | SUBROUTINE PHO_LTRANS(GAM,BGAM,CX,CY,CZ,COD,COF,SIF,P,ECM, | |
31797 | & PL,CXL,CYL,CZL,EL) | |
31798 | C********************************************************************** | |
31799 | C | |
31800 | C Lorentz transformation into lab - system | |
31801 | C | |
31802 | C********************************************************************** | |
31803 | IMPLICIT DOUBLE PRECISION (A-H,O-Z) | |
31804 | SAVE | |
31805 | ||
31806 | PARAMETER ( TINY=1.D-08,TINY2=1.D-30 ) | |
31807 | ||
31808 | C input/output channels | |
31809 | INTEGER LI,LO | |
31810 | COMMON /POINOU/ LI,LO | |
31811 | ||
31812 | SID=SQRT(1.D0-COD*COD) | |
31813 | PLX=P*SID*COF | |
31814 | PLY=P*SID*SIF | |
31815 | PCMZ=P*COD | |
31816 | PLZ=GAM*PCMZ+BGAM*ECM | |
31817 | PL=SQRT(PLX*PLX+PLY*PLY+PLZ*PLZ) | |
31818 | EL=GAM*ECM+BGAM*PCMZ | |
31819 | ||
31820 | C rotation into the original direction | |
31821 | COZ=PLZ/PL | |
31822 | SIZ=SQRT(MAX((1.D0-COZ)*(1.D0+COZ),0.D0)) | |
31823 | ||
31824 | * CALL PHO_DTRANS(CX,CY,CZ,COZ,SIZ,COF,SIF,CXL,CYL,CZL) | |
31825 | ||
31826 | AX=ABS(CX) | |
31827 | AY=ABS(CY) | |
31828 | IF(AX.LT.AY) THEN | |
31829 | AMAX=AY | |
31830 | AMIN=AX | |
31831 | ELSE | |
31832 | AMAX=AX | |
31833 | AMIN=AY | |
31834 | ENDIF | |
31835 | IF (ABS(CX)-TINY) 1,1,2 | |
31836 | 1 IF (ABS(CY)-TINY) 3,3,2 | |
31837 | ||
31838 | 3 CONTINUE | |
ecf67adb | 31839 | * WRITE(LO,*) ' PHO_DTRANS CX CY CZ =',CX,CY,CZ |
9aaba0d6 | 31840 | CXL=SIZ*COF |
31841 | CYL=SIZ*SIF | |
31842 | CZL=COZ*CZ | |
ecf67adb | 31843 | * WRITE(LO,*) ' PHO_DTRANS CXL=SIZ*COF CYL=SIZ*SIF CZL=COZ' |
9aaba0d6 | 31844 | * WRITE(LO,*) CXL,CYL,CZL |
31845 | RETURN | |
31846 | ||
31847 | 2 CONTINUE | |
31848 | IF(AMAX.GT.TINY2) THEN | |
31849 | AR=AMIN/AMAX | |
31850 | AR=AR*AR | |
31851 | A=AMAX*SQRT(1.D0+AR) | |
31852 | ELSE | |
ecf67adb | 31853 | * WRITE(LO,*) ' PHO_DTRANS AMAX LE TINY2 ' |
9aaba0d6 | 31854 | GOTO 3 |
31855 | ENDIF | |
31856 | XI=SIZ*COF | |
31857 | YI=SIZ*SIF | |
31858 | ZI=COZ | |
31859 | CXL=-CY*XI/A-CZ*CX*YI/A+CX*ZI | |
31860 | CYL=CX*XI/A-CZ*CY*YI/A+CY*ZI | |
31861 | CZL=A*YI+CZ*ZI | |
31862 | ||
31863 | END | |
31864 | ||
31865 | *$ CREATE PHO_TRANS.FOR | |
31866 | *COPY PHO_TRANS | |
31867 | CDECK ID>, PHO_TRANS | |
31868 | SUBROUTINE PHO_TRANS(XO,YO,ZO,CDE,SDE,CFE,SFE,X,Y,Z) | |
31869 | C********************************************************************** | |
31870 | C | |
31871 | C rotation of coordinate frame (1) de rotation around y axis | |
31872 | C (2) fe rotation around z axis | |
31873 | C (inverse rotation to PHO_TRANI) | |
31874 | C | |
31875 | C********************************************************************** | |
31876 | IMPLICIT DOUBLE PRECISION (A-H,O-Z) | |
31877 | SAVE | |
31878 | ||
31879 | X= CDE*CFE*XO-SFE*YO+SDE*CFE*ZO | |
31880 | Y= CDE*SFE*XO+CFE*YO+SDE*SFE*ZO | |
31881 | Z=-SDE *XO +CDE *ZO | |
31882 | ||
31883 | END | |
31884 | ||
31885 | *$ CREATE PHO_TRANI.FOR | |
31886 | *COPY PHO_TRANI | |
31887 | CDECK ID>, PHO_TRANI | |
31888 | SUBROUTINE PHO_TRANI(XO,YO,ZO,CDE,SDE,CFE,SFE,X,Y,Z) | |
31889 | C********************************************************************** | |
31890 | C | |
31891 | C rotation of coordinate frame (1) -fe rotation around z axis | |
31892 | C (2) -de rotation around y axis | |
31893 | C (inverse rotation to PHO_TRANS) | |
31894 | C | |
31895 | C********************************************************************** | |
31896 | IMPLICIT DOUBLE PRECISION (A-H,O-Z) | |
31897 | SAVE | |
31898 | ||
31899 | X= CDE*CFE*XO+CDE*SFE*YO-SDE*ZO | |
31900 | Y=-SFE *XO+CFE* YO | |
31901 | Z= SDE*CFE*XO+SDE*SFE*YO+CDE*ZO | |
31902 | ||
31903 | END | |
31904 | ||
31905 | *$ CREATE pho_cpcini.FOR | |
31906 | *COPY pho_cpcini | |
31907 | CDECK ID>, pho_cpcini | |
31908 | SUBROUTINE pho_cpcini(Nrows,Number,List) | |
31909 | C*********************************************************************** | |
31910 | C | |
31911 | C initialization of particle hash table | |
31912 | C | |
31913 | C input: Number vector with Nrows entries according to PDG | |
31914 | C convention | |
31915 | C | |
31916 | C output: List vector with hash table | |
31917 | C | |
31918 | C (this code is based on the function initpns written by | |
31919 | C Gerry Lynch, LBL, January 1990) | |
31920 | C | |
31921 | C*********************************************************************** | |
31922 | IMPLICIT NONE | |
31923 | SAVE | |
31924 | ||
31925 | C input/output channels | |
31926 | INTEGER LI,LO | |
31927 | COMMON /POINOU/ LI,LO | |
31928 | ||
31929 | integer Number(*),List(*),Nrows | |
31930 | ||
31931 | Integer Nin,Nout,Ip,I | |
31932 | ||
31933 | do I = 1,577 | |
31934 | List(I) = 0 | |
31935 | enddo | |
31936 | ||
31937 | C Loop over all of the elements in the Number vector | |
31938 | ||
31939 | Do 500 Ip = 1,Nrows | |
31940 | Nin = Number(Ip) | |
31941 | ||
31942 | C Calculate a list number for this particle id number | |
31943 | If(Nin.Gt.99999.or.Nin.Le.0) Then | |
31944 | Nout = -1 | |
31945 | Else If(Nin.Le.577) Then | |
31946 | Nout = Nin | |
31947 | Else | |
31948 | Nout = Mod(Nin,577) | |
31949 | End If | |
31950 | ||
31951 | 200 continue | |
31952 | ||
31953 | If(Nout.Lt.0) Then | |
31954 | C Count the bad entries | |
31955 | WRITE(LO,'(1x,a,i10)') | |
31956 | & 'pho_cpcini: invalid particle ID',Nin | |
31957 | Go to 500 | |
31958 | End If | |
31959 | If(List(Nout).eq.0) Then | |
31960 | List(Nout) = Ip | |
31961 | Else | |
31962 | If(Nin.eq.Number(List(Nout))) Then | |
31963 | WRITE(LO,'(1x,a,i10)') | |
31964 | & 'pho_cpcini: double particle ID',Nin | |
31965 | End If | |
31966 | Nout = Nout + 5 | |
31967 | If(Nout.Gt.577) Nout = Mod(Nout, 577) | |
31968 | ||
31969 | Go to 200 | |
31970 | End If | |
31971 | 500 Continue | |
31972 | ||
31973 | END | |
31974 | ||
31975 | *$ CREATE ipho_pdg2id.FOR | |
31976 | *COPY ipho_pdg2id | |
31977 | CDECK ID>, ipho_pdg2id | |
31978 | INTEGER FUNCTION ipho_pdg2id(IDpdg) | |
31979 | C********************************************************************** | |
31980 | C | |
31981 | C calculation internal particle code using the particle index i | |
31982 | C according to the PDG proposal. | |
31983 | C | |
31984 | C input: IDpdg PDG particle number | |
31985 | C output: ipho_pdg2id internal particle code | |
31986 | C (0 for invalid IDpdg) | |
31987 | C | |
31988 | C the hash algorithm is based on a program by Gerry Lynch | |
31989 | C | |
31990 | C********************************************************************** | |
31991 | IMPLICIT NONE | |
31992 | SAVE | |
31993 | ||
31994 | integer IDpdg | |
31995 | ||
31996 | C input/output channels | |
31997 | INTEGER LI,LO | |
31998 | COMMON /POINOU/ LI,LO | |
31999 | C event debugging information | |
32000 | INTEGER NMAXD | |
32001 | PARAMETER (NMAXD=100) | |
32002 | INTEGER IDEB,KSPOM,KHPOM,KSREG,KHDIR,KACCEP,KSTRG,KHTRG,KSLOO, | |
32003 | & KHLOO,KSDPO,KHDPO,KEVENT,KSOFT,KHARD | |
32004 | COMMON /PODEBG/ IDEB(NMAXD),KSPOM,KHPOM,KSREG,KHDIR,KACCEP,KSTRG, | |
32005 | & KHTRG,KSLOO,KHLOO,KSDPO,KHDPO,KEVENT,KSOFT,KHARD | |
32006 | C particle ID translation table | |
32007 | integer ID_pdg_list,ID_list,ID_pdg_max | |
32008 | character*12 name_list | |
32009 | COMMON /POPAR1/ ID_pdg_list(300),ID_list(577),name_list(300), | |
32010 | & ID_pdg_max | |
32011 | ||
32012 | integer Nin,Nout | |
32013 | ||
32014 | Nin = abs(IDpdg) | |
32015 | ||
32016 | if((Nin.gt.99999).or.(Nin.eq.0)) then | |
32017 | C invalid particle number | |
32018 | if(ideb(71).gt.5) WRITE(LO,'(1x,A,I10)') | |
32019 | & 'ipho_pdg2id: invalid PDG ID number ',IDpdg | |
32020 | ipho_pdg2id = 0 | |
32021 | return | |
32022 | else If(Nin.le.577) then | |
32023 | C simple case | |
32024 | Nout = Nin | |
32025 | else | |
32026 | C use hash algorithm | |
32027 | Nout = mod(Nin,577) | |
32028 | endif | |
32029 | ||
32030 | 100 continue | |
32031 | ||
32032 | C particle not in table | |
32033 | if(ID_list(Nout).Eq.0) then | |
32034 | if(ideb(71).ge.0) WRITE(LO,'(1x,A,I10)') | |
32035 | & 'ipho_pdg2id: particle not in table ',IDpdg | |
32036 | ipho_pdg2id = 0 | |
32037 | return | |
32038 | endif | |
32039 | ||
32040 | if(ID_pdg_list(ID_list(Nout)).eq.Nin) then | |
32041 | C particle ID found | |
32042 | ipho_pdg2id = sign(ID_list(Nout),IDpdg) | |
32043 | return | |
32044 | else | |
32045 | C increment and try again | |
32046 | Nout = Nout + 5 | |
32047 | If(Nout.gt.577) Nout = Mod(Nout,577) | |
32048 | goto 100 | |
32049 | endif | |
32050 | ||
32051 | END | |
32052 | ||
32053 | *$ CREATE IPHO_ID2PDG.FOR | |
32054 | *COPY IPHO_ID2PDG | |
32055 | CDECK ID>, IPHO_ID2PDG | |
32056 | INTEGER FUNCTION ipho_id2pdg(IDcpc) | |
32057 | C********************************************************************** | |
32058 | C | |
32059 | C conversion of internal particle code to PDG standard | |
32060 | C | |
32061 | C input: IDcpc internal particle number | |
32062 | C output: ipho_id2pdg PDG particle number | |
32063 | C (0 for invalid IDcpc) | |
32064 | C | |
32065 | C********************************************************************** | |
32066 | IMPLICIT NONE | |
32067 | SAVE | |
32068 | ||
32069 | integer IDcpc | |
32070 | ||
32071 | C input/output channels | |
32072 | INTEGER LI,LO | |
32073 | COMMON /POINOU/ LI,LO | |
32074 | C event debugging information | |
32075 | INTEGER NMAXD | |
32076 | PARAMETER (NMAXD=100) | |
32077 | INTEGER IDEB,KSPOM,KHPOM,KSREG,KHDIR,KACCEP,KSTRG,KHTRG,KSLOO, | |
32078 | & KHLOO,KSDPO,KHDPO,KEVENT,KSOFT,KHARD | |
32079 | COMMON /PODEBG/ IDEB(NMAXD),KSPOM,KHPOM,KSREG,KHDIR,KACCEP,KSTRG, | |
32080 | & KHTRG,KSLOO,KHLOO,KSDPO,KHDPO,KEVENT,KSOFT,KHARD | |
32081 | C particle ID translation table | |
32082 | integer ID_pdg_list,ID_list,ID_pdg_max | |
32083 | character*12 name_list | |
32084 | COMMON /POPAR1/ ID_pdg_list(300),ID_list(577),name_list(300), | |
32085 | & ID_pdg_max | |
32086 | ||
32087 | integer IDabs | |
32088 | ||
32089 | IDabs = abs(IDcpc) | |
32090 | if((IDabs.lt.1).or.(IDabs.gt.ID_pdg_max)) then | |
32091 | ipho_id2pdg = 0 | |
32092 | return | |
32093 | endif | |
32094 | ||
32095 | ipho_id2pdg = sign(ID_pdg_list(IDabs),IDcpc) | |
32096 | ||
32097 | END | |
32098 | ||
32099 | *$ CREATE IPHO_LU2PDG.FOR | |
32100 | *COPY IPHO_LU2PDG | |
32101 | CDECK ID>, IPHO_LU2PDG | |
32102 | INTEGER FUNCTION IPHO_LU2PDG(LUKF) | |
32103 | C********************************************************************** | |
32104 | C | |
32105 | C conversion of JETSET KF code to PDG code | |
32106 | C | |
32107 | C********************************************************************** | |
32108 | IMPLICIT DOUBLE PRECISION (A-H,O-Z) | |
32109 | SAVE | |
32110 | PARAMETER (NTAB=10) | |
32111 | DIMENSION LU2PD(2,NTAB) | |
32112 | DATA LU2PD / 4232, 4322, | |
32113 | & 4322, 4232, | |
32114 | & 3212, 3122, | |
32115 | & 3122, 3212, | |
32116 | & 30553, 20553, | |
32117 | & 30443, 20443, | |
32118 | & 20443, 10443, | |
32119 | & 10443, 0, | |
32120 | & 511, 0, | |
32121 | & 10551, 551 / | |
32122 | C | |
32123 | DO 100 I=1,NTAB | |
32124 | IF(LU2PD(1,I).EQ.LUKF) THEN | |
32125 | IPHO_LU2PDG=LU2PD(2,I) | |
32126 | RETURN | |
32127 | ENDIF | |
32128 | 100 CONTINUE | |
32129 | IPHO_LU2PDG=LUKF | |
32130 | ||
32131 | END | |
32132 | ||
32133 | *$ CREATE IPHO_PDG2LU.FOR | |
32134 | *COPY IPHO_PDG2LU | |
32135 | CDECK ID>, IPHO_PDG2LU | |
32136 | INTEGER FUNCTION IPHO_PDG2LU(IPDG) | |
32137 | C********************************************************************** | |
32138 | C | |
32139 | C conversion of PDG code to JETSET code | |
32140 | C | |
32141 | C********************************************************************** | |
32142 | IMPLICIT DOUBLE PRECISION (A-H,O-Z) | |
32143 | SAVE | |
32144 | PARAMETER (NTAB=8) | |
32145 | DIMENSION LU2PD(2,NTAB) | |
32146 | DATA LU2PD / 4232, 4322, | |
32147 | & 4322, 4232, | |
32148 | & 3212, 3122, | |
32149 | & 3122, 3212, | |
32150 | & 30553, 20553, | |
32151 | & 30443, 20443, | |
32152 | & 20443, 10443, | |
32153 | & 10551, 551 / | |
32154 | C | |
32155 | DO 100 I=1,NTAB | |
32156 | IF(LU2PD(2,I).EQ.IPDG) THEN | |
32157 | IPHO_PDG2LU=LU2PD(1,I) | |
32158 | RETURN | |
32159 | ENDIF | |
32160 | 100 CONTINUE | |
32161 | IPHO_PDG2LU=IPDG | |
32162 | ||
32163 | END | |
32164 | ||
32165 | *$ CREATE pho_pname.FOR | |
32166 | *COPY pho_pname | |
32167 | CDECK ID>, pho_pname | |
32168 | CHARACTER*15 FUNCTION pho_pname(ID,mode) | |
32169 | C*********************************************************************** | |
32170 | C | |
32171 | C returns particle name for given ID number | |
32172 | C | |
32173 | C input: ID particle ID number | |
32174 | C mode 0: ID treated as compressed particle code | |
32175 | C 1: ID treated as PDG number | |
32176 | C | |
32177 | C*********************************************************************** | |
32178 | IMPLICIT NONE | |
32179 | SAVE | |
32180 | ||
32181 | integer ID,mode | |
32182 | ||
32183 | C input/output channels | |
32184 | INTEGER LI,LO | |
32185 | COMMON /POINOU/ LI,LO | |
32186 | C standard particle data interface | |
32187 | INTEGER NMXHEP | |
32188 | PARAMETER (NMXHEP=4000) | |
32189 | INTEGER NEVHEP,NHEP,ISTHEP,IDHEP,JMOHEP,JDAHEP | |
32190 | DOUBLE PRECISION PHEP,VHEP | |
32191 | COMMON /POEVT1/ NEVHEP,NHEP,ISTHEP(NMXHEP),IDHEP(NMXHEP), | |
32192 | & JMOHEP(2,NMXHEP),JDAHEP(2,NMXHEP),PHEP(5,NMXHEP), | |
32193 | & VHEP(4,NMXHEP) | |
32194 | C extension to standard particle data interface (PHOJET specific) | |
32195 | INTEGER IMPART,IPHIST,ICOLOR | |
32196 | COMMON /POEVT2/ IMPART(NMXHEP),IPHIST(2,NMXHEP),ICOLOR(2,NMXHEP) | |
32197 | C particle ID translation table | |
32198 | integer ID_pdg_list,ID_list,ID_pdg_max | |
32199 | character*12 name_list | |
32200 | COMMON /POPAR1/ ID_pdg_list(300),ID_list(577),name_list(300), | |
32201 | & ID_pdg_max | |
32202 | C general particle data | |
32203 | double precision xm_list,tau_list,gam_list, | |
32204 | & xm_psm2_list,xm_vem2_list,xm_b82_list,xm_b102_list, | |
32205 | & xm_bb82_list,xm_bb102_list | |
32206 | integer ich3_list,iba3_list,iq_list, | |
32207 | & id_psm_list,id_vem_list,id_b8_list,id_b10_list | |
32208 | COMMON /POPAR2/ xm_list(300),tau_list(300),gam_list(300), | |
32209 | & xm_psm2_list(6,6),xm_vem2_list(6,6), | |
32210 | & xm_b82_list(6,6,6),xm_b102_list(6,6,6), | |
32211 | & xm_bb82_list(6,6,6,6),xm_bb102_list(6,6,6,6), | |
32212 | & ich3_list(300),iba3_list(300),iq_list(3,300), | |
32213 | & id_psm_list(6,6),id_vem_list(6,6), | |
32214 | & id_b8_list(6,6,6),id_b10_list(6,6,6) | |
32215 | ||
32216 | C external functions | |
32217 | integer ipho_id2pdg,ipho_pdg2id | |
32218 | ||
32219 | C local variables | |
32220 | integer IDpdg,i,ii,k,l,ichar,i_anti | |
32221 | character*15 name | |
32222 | ||
32223 | pho_pname = '(?????????????)' | |
32224 | ||
32225 | if(mode.eq.0) then | |
32226 | i = ID | |
32227 | IDpdg = ipho_id2pdg(ID) | |
32228 | if(IDpdg.eq.0) return | |
32229 | else if(mode.eq.1) then | |
32230 | i = ipho_pdg2id(ID) | |
32231 | if(i.eq.0) return | |
32232 | IDpdg = ID | |
32233 | else if(mode.eq.2) then | |
32234 | if(ISTHEP(ID).gt.11) then | |
32235 | if(ISTHEP(ID).eq.20) then | |
32236 | pho_pname = 'hard ini. part.' | |
32237 | else if(ISTHEP(ID).eq.21) then | |
32238 | pho_pname = 'hard fin. part.' | |
32239 | else if(ISTHEP(ID).eq.25) then | |
32240 | pho_pname = 'hard scattering' | |
32241 | else if(ISTHEP(ID).eq.30) then | |
32242 | pho_pname = 'diff. diss. ' | |
32243 | else if(ISTHEP(ID).eq.35) then | |
32244 | pho_pname = 'elastic scatt. ' | |
32245 | else if(ISTHEP(ID).eq.40) then | |
32246 | pho_pname = 'central scatt. ' | |
32247 | endif | |
32248 | return | |
32249 | endif | |
32250 | IDpdg = IDHEP(ID) | |
32251 | i = IMPART(ID) | |
32252 | else | |
32253 | WRITE(LO,'(1x,a,2i4)') | |
32254 | & 'pho_pname: invalid arguments (ID,mode): ',ID,mode | |
32255 | return | |
32256 | endif | |
32257 | ||
32258 | ii = abs(i) | |
32259 | if((ii.eq.0).or.(ii.gt.ID_pdg_max)) return | |
32260 | ||
32261 | name = name_list(ii) | |
32262 | ichar = ich3_list(ii)*sign(1,i) | |
32263 | if(mod(ichar,3).ne.0) then | |
32264 | ichar = 0 | |
32265 | else | |
32266 | ichar = ichar/3 | |
32267 | endif | |
32268 | ||
32269 | C find position of first blank character | |
32270 | k = 1 | |
32271 | 100 continue | |
32272 | k = k+1 | |
32273 | if(name(k:k).ne.' ') goto 100 | |
32274 | ||
32275 | C append anti-particle sign | |
32276 | if(i.lt.0) then | |
32277 | i_anti = 0 | |
32278 | do l=1,3 | |
32279 | i_anti = i_anti+iq_list(l,ii) | |
32280 | enddo | |
32281 | if(iba3_list(ii).ne.0) then | |
32282 | name(k:k) = '~' | |
32283 | k = K+1 | |
32284 | else if(((i_anti.ne.0).and.(ichar.eq.0)) | |
32285 | & .or.(IDpdg.eq.-12) | |
32286 | & .or.(IDpdg.eq.-14) | |
32287 | & .or.(IDpdg.eq.-16)) then | |
32288 | name(k:k) = '~' | |
32289 | k = K+1 | |
32290 | endif | |
32291 | endif | |
32292 | ||
32293 | C append charge sign | |
32294 | if(ichar.eq.-2) then | |
32295 | name(k:k+1) = '--' | |
32296 | else if(ichar.eq.-1) then | |
32297 | name(k:k) = '-' | |
32298 | else if(ichar.eq.1) then | |
32299 | name(k:k) = '+' | |
32300 | else if(ichar.eq.2) then | |
32301 | name(k:k+1) = '++' | |
32302 | endif | |
32303 | ||
32304 | pho_pname = name | |
32305 | ||
32306 | END | |
32307 | ||
32308 | *$ CREATE ipho_anti.FOR | |
32309 | *COPY ipho_anti | |
32310 | CDECK ID>, ipho_anti | |
32311 | INTEGER FUNCTION ipho_anti(ID) | |
32312 | C********************************************************************** | |
32313 | C | |
32314 | C determine antiparticle for given ID | |
32315 | C | |
32316 | C input: ID gives CPC particle number | |
32317 | C | |
32318 | C output: ipho_anti antiparticle code | |
32319 | C | |
32320 | C********************************************************************** | |
32321 | IMPLICIT NONE | |
32322 | SAVE | |
32323 | ||
32324 | integer ID | |
32325 | ||
32326 | C input/output channels | |
32327 | INTEGER LI,LO | |
32328 | COMMON /POINOU/ LI,LO | |
32329 | C event debugging information | |
32330 | INTEGER NMAXD | |
32331 | PARAMETER (NMAXD=100) | |
32332 | INTEGER IDEB,KSPOM,KHPOM,KSREG,KHDIR,KACCEP,KSTRG,KHTRG,KSLOO, | |
32333 | & KHLOO,KSDPO,KHDPO,KEVENT,KSOFT,KHARD | |
32334 | COMMON /PODEBG/ IDEB(NMAXD),KSPOM,KHPOM,KSREG,KHDIR,KACCEP,KSTRG, | |
32335 | & KHTRG,KSLOO,KHLOO,KSDPO,KHDPO,KEVENT,KSOFT,KHARD | |
32336 | C particle ID translation table | |
32337 | integer ID_pdg_list,ID_list,ID_pdg_max | |
32338 | character*12 name_list | |
32339 | COMMON /POPAR1/ ID_pdg_list(300),ID_list(577),name_list(300), | |
32340 | & ID_pdg_max | |
32341 | C general particle data | |
32342 | double precision xm_list,tau_list,gam_list, | |
32343 | & xm_psm2_list,xm_vem2_list,xm_b82_list,xm_b102_list, | |
32344 | & xm_bb82_list,xm_bb102_list | |
32345 | integer ich3_list,iba3_list,iq_list, | |
32346 | & id_psm_list,id_vem_list,id_b8_list,id_b10_list | |
32347 | COMMON /POPAR2/ xm_list(300),tau_list(300),gam_list(300), | |
32348 | & xm_psm2_list(6,6),xm_vem2_list(6,6), | |
32349 | & xm_b82_list(6,6,6),xm_b102_list(6,6,6), | |
32350 | & xm_bb82_list(6,6,6,6),xm_bb102_list(6,6,6,6), | |
32351 | & ich3_list(300),iba3_list(300),iq_list(3,300), | |
32352 | & id_psm_list(6,6),id_vem_list(6,6), | |
32353 | & id_b8_list(6,6,6),id_b10_list(6,6,6) | |
32354 | C standard particle data interface | |
32355 | INTEGER NMXHEP | |
32356 | PARAMETER (NMXHEP=4000) | |
32357 | INTEGER NEVHEP,NHEP,ISTHEP,IDHEP,JMOHEP,JDAHEP | |
32358 | DOUBLE PRECISION PHEP,VHEP | |
32359 | COMMON /POEVT1/ NEVHEP,NHEP,ISTHEP(NMXHEP),IDHEP(NMXHEP), | |
32360 | & JMOHEP(2,NMXHEP),JDAHEP(2,NMXHEP),PHEP(5,NMXHEP), | |
32361 | & VHEP(4,NMXHEP) | |
32362 | C extension to standard particle data interface (PHOJET specific) | |
32363 | INTEGER IMPART,IPHIST,ICOLOR | |
32364 | COMMON /POEVT2/ IMPART(NMXHEP),IPHIST(2,NMXHEP),ICOLOR(2,NMXHEP) | |
32365 | ||
32366 | C external functions | |
32367 | integer ipho_id2pdg,ipho_pdg2id | |
32368 | ||
32369 | C local variables | |
32370 | integer IDabs,IDpdg,i_anti,l | |
32371 | ||
32372 | ipho_anti = -ID | |
32373 | IDabs = abs(ID) | |
32374 | ||
32375 | C baryons | |
32376 | if(iba3_list(IDabs).ne.0) return | |
32377 | ||
32378 | C charged particles | |
32379 | if(ich3_list(IDabs).ne.0) return | |
32380 | ||
32381 | C K0_s and K0_l | |
32382 | IDpdg = ipho_id2pdg(ID) | |
32383 | if(IDpdg.eq.310) then | |
32384 | ID = ipho_pdg2id(130) | |
32385 | return | |
32386 | else if(IDpdg.eq.130) then | |
32387 | ID = ipho_pdg2id(310) | |
32388 | return | |
32389 | endif | |
32390 | ||
32391 | C neutral mesons with open strangeness, charm, or beauty | |
32392 | i_anti = 0 | |
32393 | do l=1,3 | |
32394 | i_anti = i_anti+iq_list(l,IDabs) | |
32395 | enddo | |
32396 | if(i_anti.ne.0) return | |
32397 | ||
32398 | C neutrinos | |
32399 | IDpdg = abs(IDpdg) | |
32400 | if((IDpdg.eq.12).or.(IDpdg.eq.14).or.(IDpdg.eq.16)) return | |
32401 | ||
32402 | ipho_anti = ID | |
32403 | ||
32404 | END | |
32405 | ||
32406 | *$ CREATE ipho_chr3.FOR | |
32407 | *COPY ipho_chr3 | |
32408 | CDECK ID>, ipho_chr3 | |
32409 | INTEGER FUNCTION ipho_chr3(ID,mode) | |
32410 | C********************************************************************** | |
32411 | C | |
32412 | C output of three times the electric charge | |
32413 | C | |
32414 | C input: mode | |
32415 | C 0 ID gives CPC particle number | |
32416 | C 1 ID gives PDG particle number | |
32417 | C 2 ID gives position of particle in /POEVT1/ | |
32418 | C | |
32419 | C********************************************************************** | |
32420 | IMPLICIT NONE | |
32421 | SAVE | |
32422 | ||
32423 | integer ID,mode | |
32424 | ||
32425 | C input/output channels | |
32426 | INTEGER LI,LO | |
32427 | COMMON /POINOU/ LI,LO | |
32428 | C event debugging information | |
32429 | INTEGER NMAXD | |
32430 | PARAMETER (NMAXD=100) | |
32431 | INTEGER IDEB,KSPOM,KHPOM,KSREG,KHDIR,KACCEP,KSTRG,KHTRG,KSLOO, | |
32432 | & KHLOO,KSDPO,KHDPO,KEVENT,KSOFT,KHARD | |
32433 | COMMON /PODEBG/ IDEB(NMAXD),KSPOM,KHPOM,KSREG,KHDIR,KACCEP,KSTRG, | |
32434 | & KHTRG,KSLOO,KHLOO,KSDPO,KHDPO,KEVENT,KSOFT,KHARD | |
32435 | C standard particle data interface | |
32436 | INTEGER NMXHEP | |
32437 | PARAMETER (NMXHEP=4000) | |
32438 | INTEGER NEVHEP,NHEP,ISTHEP,IDHEP,JMOHEP,JDAHEP | |
32439 | DOUBLE PRECISION PHEP,VHEP | |
32440 | COMMON /POEVT1/ NEVHEP,NHEP,ISTHEP(NMXHEP),IDHEP(NMXHEP), | |
32441 | & JMOHEP(2,NMXHEP),JDAHEP(2,NMXHEP),PHEP(5,NMXHEP), | |
32442 | & VHEP(4,NMXHEP) | |
32443 | C extension to standard particle data interface (PHOJET specific) | |
32444 | INTEGER IMPART,IPHIST,ICOLOR | |
32445 | COMMON /POEVT2/ IMPART(NMXHEP),IPHIST(2,NMXHEP),ICOLOR(2,NMXHEP) | |
32446 | C particle ID translation table | |
32447 | integer ID_pdg_list,ID_list,ID_pdg_max | |
32448 | character*12 name_list | |
32449 | COMMON /POPAR1/ ID_pdg_list(300),ID_list(577),name_list(300), | |
32450 | & ID_pdg_max | |
32451 | C general particle data | |
32452 | double precision xm_list,tau_list,gam_list, | |
32453 | & xm_psm2_list,xm_vem2_list,xm_b82_list,xm_b102_list, | |
32454 | & xm_bb82_list,xm_bb102_list | |
32455 | integer ich3_list,iba3_list,iq_list, | |
32456 | & id_psm_list,id_vem_list,id_b8_list,id_b10_list | |
32457 | COMMON /POPAR2/ xm_list(300),tau_list(300),gam_list(300), | |
32458 | & xm_psm2_list(6,6),xm_vem2_list(6,6), | |
32459 | & xm_b82_list(6,6,6),xm_b102_list(6,6,6), | |
32460 | & xm_bb82_list(6,6,6,6),xm_bb102_list(6,6,6,6), | |
32461 | & ich3_list(300),iba3_list(300),iq_list(3,300), | |
32462 | & id_psm_list(6,6),id_vem_list(6,6), | |
32463 | & id_b8_list(6,6,6),id_b10_list(6,6,6) | |
32464 | ||
32465 | C external functions | |
32466 | integer ipho_pdg2id | |
32467 | ||
32468 | C local variables | |
32469 | integer i,IDpdg | |
32470 | ||
32471 | ipho_chr3 = 0 | |
32472 | ||
32473 | if(mode.eq.0) then | |
32474 | i = ID | |
32475 | else if(mode.eq.1) then | |
32476 | i = ipho_pdg2id(ID) | |
32477 | if(i.eq.0) return | |
32478 | IDpdg = ID | |
32479 | else if(mode.eq.2) then | |
32480 | if(ISTHEP(ID).gt.11) return | |
32481 | i = IMPART(ID) | |
32482 | IDpdg = IDHEP(ID) | |
32483 | IF((IDpdg.eq.90).or.(IDpdg.eq.91).or.(IDpdg.eq.92)) then | |
32484 | ipho_chr3 = ICOLOR(1,ID) | |
32485 | return | |
32486 | endif | |
32487 | else | |
32488 | WRITE(LO,'(1x,a,2i4)') | |
32489 | & 'ipho_chr3: invalid mode (ID,mode): ',ID,mode | |
32490 | return | |
32491 | endif | |
32492 | ||
32493 | if((i.eq.0).or.(iabs(i).gt.ID_pdg_max)) then | |
32494 | WRITE(LO,'(1x,a,3i8)') | |
32495 | & 'ipho_chr3: invalid arguments (ID,mode,i): ',ID,mode,i | |
32496 | ipho_chr3 = 1.D0/dble(i) | |
32497 | call pho_prevnt(0) | |
32498 | return | |
32499 | endif | |
32500 | ||
32501 | ipho_chr3 = ich3_list(iabs(i))*sign(1,i) | |
32502 | ||
32503 | END | |
32504 | ||
32505 | *$ CREATE ipho_bar3.FOR | |
32506 | *COPY ipho_bar3 | |
32507 | CDECK ID>, ipho_bar3 | |
32508 | INTEGER FUNCTION ipho_bar3(ID,mode) | |
32509 | C********************************************************************** | |
32510 | C | |
32511 | C output of three times the baryon charge | |
32512 | C | |
32513 | C index: MODE | |
32514 | C 0 ID gives CPC particle number | |
32515 | C 1 ID gives PDG particle number | |
32516 | C 2 ID gives position of particle in /POEVT1/ | |
32517 | C | |
32518 | C********************************************************************** | |
32519 | IMPLICIT NONE | |
32520 | SAVE | |
32521 | ||
32522 | integer ID,mode | |
32523 | ||
32524 | C input/output channels | |
32525 | INTEGER LI,LO | |
32526 | COMMON /POINOU/ LI,LO | |
32527 | C event debugging information | |
32528 | INTEGER NMAXD | |
32529 | PARAMETER (NMAXD=100) | |
32530 | INTEGER IDEB,KSPOM,KHPOM,KSREG,KHDIR,KACCEP,KSTRG,KHTRG,KSLOO, | |
32531 | & KHLOO,KSDPO,KHDPO,KEVENT,KSOFT,KHARD | |
32532 | COMMON /PODEBG/ IDEB(NMAXD),KSPOM,KHPOM,KSREG,KHDIR,KACCEP,KSTRG, | |
32533 | & KHTRG,KSLOO,KHLOO,KSDPO,KHDPO,KEVENT,KSOFT,KHARD | |
32534 | C standard particle data interface | |
32535 | INTEGER NMXHEP | |
32536 | PARAMETER (NMXHEP=4000) | |
32537 | INTEGER NEVHEP,NHEP,ISTHEP,IDHEP,JMOHEP,JDAHEP | |
32538 | DOUBLE PRECISION PHEP,VHEP | |
32539 | COMMON /POEVT1/ NEVHEP,NHEP,ISTHEP(NMXHEP),IDHEP(NMXHEP), | |
32540 | & JMOHEP(2,NMXHEP),JDAHEP(2,NMXHEP),PHEP(5,NMXHEP), | |
32541 | & VHEP(4,NMXHEP) | |
32542 | C extension to standard particle data interface (PHOJET specific) | |
32543 | INTEGER IMPART,IPHIST,ICOLOR | |
32544 | COMMON /POEVT2/ IMPART(NMXHEP),IPHIST(2,NMXHEP),ICOLOR(2,NMXHEP) | |
32545 | C particle ID translation table | |
32546 | integer ID_pdg_list,ID_list,ID_pdg_max | |
32547 | character*12 name_list | |
32548 | COMMON /POPAR1/ ID_pdg_list(300),ID_list(577),name_list(300), | |
32549 | & ID_pdg_max | |
32550 | C general particle data | |
32551 | double precision xm_list,tau_list,gam_list, | |
32552 | & xm_psm2_list,xm_vem2_list,xm_b82_list,xm_b102_list, | |
32553 | & xm_bb82_list,xm_bb102_list | |
32554 | integer ich3_list,iba3_list,iq_list, | |
32555 | & id_psm_list,id_vem_list,id_b8_list,id_b10_list | |
32556 | COMMON /POPAR2/ xm_list(300),tau_list(300),gam_list(300), | |
32557 | & xm_psm2_list(6,6),xm_vem2_list(6,6), | |
32558 | & xm_b82_list(6,6,6),xm_b102_list(6,6,6), | |
32559 | & xm_bb82_list(6,6,6,6),xm_bb102_list(6,6,6,6), | |
32560 | & ich3_list(300),iba3_list(300),iq_list(3,300), | |
32561 | & id_psm_list(6,6),id_vem_list(6,6), | |
32562 | & id_b8_list(6,6,6),id_b10_list(6,6,6) | |
32563 | ||
32564 | C external functions | |
32565 | integer ipho_pdg2id | |
32566 | ||
32567 | C local variables | |
32568 | integer i,IDpdg | |
32569 | ||
32570 | ipho_bar3 = 0 | |
32571 | ||
32572 | if(mode.eq.0) then | |
32573 | i = ID | |
32574 | else if(mode.eq.1) then | |
32575 | i = ipho_pdg2id(ID) | |
32576 | if(i.eq.0) return | |
32577 | IDpdg = ID | |
32578 | else if(mode.eq.2) then | |
32579 | if(ISTHEP(ID).gt.11) return | |
32580 | i = IMPART(ID) | |
32581 | IDpdg = IDHEP(ID) | |
32582 | IF((IDpdg.eq.90).or.(IDpdg.eq.91).or.(IDpdg.eq.92)) then | |
32583 | ipho_bar3 = ICOLOR(2,ID) | |
32584 | return | |
32585 | endif | |
32586 | else | |
32587 | WRITE(LO,'(1x,a,2i4)') | |
32588 | & 'ipho_bar3: invalid mode (ID,mode): ',ID,mode | |
32589 | return | |
32590 | endif | |
32591 | ||
32592 | if((i.eq.0).or.(iabs(i).gt.ID_pdg_max)) then | |
32593 | WRITE(LO,'(1x,a,3i8)') | |
32594 | & 'ipho_bar3: invalid arguments (ID,mode,i): ',ID,mode,i | |
32595 | ipho_bar3 = 1.D0/dble(i) | |
32596 | return | |
32597 | endif | |
32598 | ||
32599 | ipho_bar3 = iba3_list(iabs(i))*sign(1,i) | |
32600 | ||
32601 | END | |
32602 | ||
32603 | *$ CREATE pho_pmass.FOR | |
32604 | *COPY pho_pmass | |
32605 | CDECK ID>, pho_pmass | |
32606 | DOUBLE PRECISION FUNCTION pho_pmass(ID,mode) | |
32607 | C*********************************************************************** | |
32608 | C | |
32609 | C particle mass | |
32610 | C | |
32611 | C input: mode -1 initialization | |
32612 | C 0 ID gives CPC particle number | |
32613 | C 1 ID gives PDG particle number, | |
32614 | C (for quarks current masses are returned) | |
32615 | C 2 ID gives position of particle in /POEVT1/ | |
32616 | C 3 ID gives PDG parton number, | |
32617 | C (for quarks constituent masses are returned) | |
32618 | C | |
32619 | C output: average particle mass (in GeV) | |
32620 | C | |
32621 | C*********************************************************************** | |
32622 | IMPLICIT NONE | |
32623 | SAVE | |
32624 | ||
32625 | integer ID,mode,MSTJ24 | |
32626 | ||
32627 | C input/output channels | |
32628 | INTEGER LI,LO | |
32629 | COMMON /POINOU/ LI,LO | |
32630 | C event debugging information | |
32631 | INTEGER NMAXD | |
32632 | PARAMETER (NMAXD=100) | |
32633 | INTEGER IDEB,KSPOM,KHPOM,KSREG,KHDIR,KACCEP,KSTRG,KHTRG,KSLOO, | |
32634 | & KHLOO,KSDPO,KHDPO,KEVENT,KSOFT,KHARD | |
32635 | COMMON /PODEBG/ IDEB(NMAXD),KSPOM,KHPOM,KSREG,KHDIR,KACCEP,KSTRG, | |
32636 | & KHTRG,KSLOO,KHLOO,KSDPO,KHDPO,KEVENT,KSOFT,KHARD | |
32637 | C model switches and parameters | |
32638 | CHARACTER*8 MDLNA | |
32639 | INTEGER ISWMDL,IPAMDL | |
32640 | DOUBLE PRECISION PARMDL | |
32641 | COMMON /POMDLS/ MDLNA(50),ISWMDL(50),PARMDL(400),IPAMDL(400) | |
32642 | C standard particle data interface | |
32643 | INTEGER NMXHEP | |
32644 | PARAMETER (NMXHEP=4000) | |
32645 | INTEGER NEVHEP,NHEP,ISTHEP,IDHEP,JMOHEP,JDAHEP | |
32646 | DOUBLE PRECISION PHEP,VHEP | |
32647 | COMMON /POEVT1/ NEVHEP,NHEP,ISTHEP(NMXHEP),IDHEP(NMXHEP), | |
32648 | & JMOHEP(2,NMXHEP),JDAHEP(2,NMXHEP),PHEP(5,NMXHEP), | |
32649 | & VHEP(4,NMXHEP) | |
32650 | C extension to standard particle data interface (PHOJET specific) | |
32651 | INTEGER IMPART,IPHIST,ICOLOR | |
32652 | COMMON /POEVT2/ IMPART(NMXHEP),IPHIST(2,NMXHEP),ICOLOR(2,NMXHEP) | |
32653 | C particle ID translation table | |
32654 | integer ID_pdg_list,ID_list,ID_pdg_max | |
32655 | character*12 name_list | |
32656 | COMMON /POPAR1/ ID_pdg_list(300),ID_list(577),name_list(300), | |
32657 | & ID_pdg_max | |
32658 | C general particle data | |
32659 | double precision xm_list,tau_list,gam_list, | |
32660 | & xm_psm2_list,xm_vem2_list,xm_b82_list,xm_b102_list, | |
32661 | & xm_bb82_list,xm_bb102_list | |
32662 | integer ich3_list,iba3_list,iq_list, | |
32663 | & id_psm_list,id_vem_list,id_b8_list,id_b10_list | |
32664 | COMMON /POPAR2/ xm_list(300),tau_list(300),gam_list(300), | |
32665 | & xm_psm2_list(6,6),xm_vem2_list(6,6), | |
32666 | & xm_b82_list(6,6,6),xm_b102_list(6,6,6), | |
32667 | & xm_bb82_list(6,6,6,6),xm_bb102_list(6,6,6,6), | |
32668 | & ich3_list(300),iba3_list(300),iq_list(3,300), | |
32669 | & id_psm_list(6,6),id_vem_list(6,6), | |
32670 | & id_b8_list(6,6,6),id_b10_list(6,6,6) | |
32671 | INTEGER MSTU,MSTJ | |
32672 | DOUBLE PRECISION PARU,PARJ | |
32673 | COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) | |
32674 | ||
32675 | C external functions | |
32676 | integer ipho_pdg2id,ipho_id2pdg | |
32677 | DOUBLE PRECISION PYMASS | |
32678 | ||
32679 | C local variables | |
32680 | integer i,IDpdg | |
32681 | ||
32682 | pho_pmass = 0.D0 | |
32683 | ||
32684 | if(mode.eq.0) then | |
32685 | i = ID | |
32686 | else if(mode.eq.1) then | |
32687 | i = ipho_pdg2id(ID) | |
32688 | if(i.eq.0) return | |
32689 | else if(mode.eq.2) then | |
32690 | if(ISTHEP(ID).gt.11) return | |
32691 | i = IMPART(ID) | |
32692 | IDpdg = IDHEP(ID) | |
32693 | IF((IDpdg.eq.90).or.(IDpdg.eq.91).or.(IDpdg.eq.92)) then | |
32694 | pho_pmass = PHEP(5,ID) | |
32695 | return | |
32696 | endif | |
32697 | else if(mode.eq.3) then | |
32698 | i = abs(ID) | |
32699 | if((i.gt.0).and.(i.le.6)) then | |
32700 | pho_pmass = PARMDL(150+i) | |
32701 | return | |
32702 | else | |
32703 | i = ipho_pdg2id(ID) | |
32704 | if(i.eq.0) return | |
32705 | endif | |
32706 | else if(mode.eq.-1) then | |
32707 | C initialization: take masses for quarks and di-quarks from JETSET | |
32708 | MSTJ24 = MSTJ(24) | |
32709 | MSTJ(24) = 0 | |
32710 | do i=1,22 | |
32711 | IDpdg = ipho_id2pdg(i) | |
32712 | xm_list(i) = PYMASS(IDpdg) | |
32713 | enddo | |
32714 | MSTJ(24) = MSTJ24 | |
32715 | return | |
32716 | else | |
32717 | WRITE(LO,'(1x,a,2i4)') | |
32718 | & 'pho_pmass: invalid arguments (ID,mode): ',ID,mode | |
32719 | return | |
32720 | endif | |
32721 | ||
32722 | if((i.eq.0).or.(iabs(i).gt.ID_pdg_max)) then | |
32723 | WRITE(LO,'(1x,a,2i8)') | |
32724 | & 'pho_pmass: invalid arguments (ID,mode): ',ID,mode | |
32725 | pho_pmass = 1.D0/dble(i) | |
32726 | return | |
32727 | endif | |
32728 | ||
32729 | pho_pmass = xm_list(iabs(i)) | |
32730 | ||
32731 | END | |
32732 | ||
32733 | *$ CREATE PHO_MEMASS.FOR | |
32734 | *COPY PHO_MEMASS | |
32735 | CDECK ID>, PHO_MEMASS | |
32736 | SUBROUTINE PHO_MEMASS(I,J,AMPS,AMPS2,AMVE,AMVE2,IPS,IVE) | |
32737 | C********************************************************************** | |
32738 | C | |
32739 | C determine meson masses corresponding to the input flavours | |
32740 | C | |
32741 | C input: I,J,K quark flavours (PDG convention) | |
32742 | C | |
32743 | C output: AMPS pseudo scalar meson mass | |
32744 | C AMPS2 next possible two particle configuration | |
32745 | C (two pseudo scalar mesons) | |
32746 | C AMVE vector meson mass | |
32747 | C AMVE2 next possible two particle configuration | |
32748 | C (two vector mesons) | |
32749 | C IPS,IVE meson numbers in CPC | |
32750 | C | |
32751 | C********************************************************************** | |
32752 | IMPLICIT NONE | |
32753 | SAVE | |
32754 | ||
32755 | integer I,J,IPS,IVE | |
32756 | double precision AMPS,AMPS2,AMVE,AMVE2 | |
32757 | ||
32758 | C input/output channels | |
32759 | INTEGER LI,LO | |
32760 | COMMON /POINOU/ LI,LO | |
32761 | C event debugging information | |
32762 | INTEGER NMAXD | |
32763 | PARAMETER (NMAXD=100) | |
32764 | INTEGER IDEB,KSPOM,KHPOM,KSREG,KHDIR,KACCEP,KSTRG,KHTRG,KSLOO, | |
32765 | & KHLOO,KSDPO,KHDPO,KEVENT,KSOFT,KHARD | |
32766 | COMMON /PODEBG/ IDEB(NMAXD),KSPOM,KHPOM,KSREG,KHDIR,KACCEP,KSTRG, | |
32767 | & KHTRG,KSLOO,KHLOO,KSDPO,KHDPO,KEVENT,KSOFT,KHARD | |
32768 | C particle ID translation table | |
32769 | integer ID_pdg_list,ID_list,ID_pdg_max | |
32770 | character*12 name_list | |
32771 | COMMON /POPAR1/ ID_pdg_list(300),ID_list(577),name_list(300), | |
32772 | & ID_pdg_max | |
32773 | C general particle data | |
32774 | double precision xm_list,tau_list,gam_list, | |
32775 | & xm_psm2_list,xm_vem2_list,xm_b82_list,xm_b102_list, | |
32776 | & xm_bb82_list,xm_bb102_list | |
32777 | integer ich3_list,iba3_list,iq_list, | |
32778 | & id_psm_list,id_vem_list,id_b8_list,id_b10_list | |
32779 | COMMON /POPAR2/ xm_list(300),tau_list(300),gam_list(300), | |
32780 | & xm_psm2_list(6,6),xm_vem2_list(6,6), | |
32781 | & xm_b82_list(6,6,6),xm_b102_list(6,6,6), | |
32782 | & xm_bb82_list(6,6,6,6),xm_bb102_list(6,6,6,6), | |
32783 | & ich3_list(300),iba3_list(300),iq_list(3,300), | |
32784 | & id_psm_list(6,6),id_vem_list(6,6), | |
32785 | & id_b8_list(6,6,6),id_b10_list(6,6,6) | |
32786 | ||
32787 | C local variables | |
32788 | integer ii,jj | |
32789 | ||
32790 | IF(I.GT.0) THEN | |
32791 | ii = I | |
32792 | jj = -J | |
32793 | ELSE | |
32794 | ii = J | |
32795 | jj = -I | |
32796 | ENDIF | |
32797 | ||
32798 | C particle ID's | |
32799 | IPS = id_psm_list(ii,jj) | |
32800 | IVE = id_vem_list(ii,jj) | |
32801 | C masses | |
32802 | if(IPS.ne.0) then | |
32803 | AMPS = xm_list(iabs(IPS)) | |
32804 | else | |
32805 | AMPS = 0.D0 | |
32806 | endif | |
32807 | if(IVE.ne.0) then | |
32808 | AMVE = xm_list(iabs(IVE)) | |
32809 | else | |
32810 | AMVE = 0.D0 | |
32811 | endif | |
32812 | ||
32813 | C next possible two-particle configurations (add phase space) | |
32814 | AMPS2 = xm_psm2_list(ii,jj)*1.5D0 | |
32815 | AMVE2 = xm_vem2_list(ii,jj)*1.1D0 | |
32816 | ||
32817 | END | |
32818 | ||
32819 | *$ CREATE PHO_BAMASS.FOR | |
32820 | *COPY PHO_BAMASS | |
32821 | CDECK ID>, PHO_BAMASS | |
32822 | SUBROUTINE PHO_BAMASS(I,J,K,AM8,AM82,AM10,AM102,I8,I10) | |
32823 | C********************************************************************** | |
32824 | C | |
32825 | C determine baryon masses corresponding to the input flavours | |
32826 | C | |
32827 | C input: I,J,K quark flavours (PDG convention) | |
32828 | C | |
32829 | C output: AM8 octett baryon mass | |
32830 | C AM82 next possible two particle configuration | |
32831 | C (octett baryon and meson) | |
32832 | C AM10 decuplett baryon mass | |
32833 | C AM102 next possible two particle configuration | |
32834 | C (decuplett baryon and meson, | |
32835 | C baryon built up from first two quarks) | |
32836 | C I8,I10 internal baryon numbers | |
32837 | C | |
32838 | C********************************************************************** | |
32839 | IMPLICIT NONE | |
32840 | SAVE | |
32841 | ||
32842 | integer I,J,K,I8,I10 | |
32843 | double precision AM8,AM82,AM10,AM102 | |
32844 | ||
32845 | C input/output channels | |
32846 | INTEGER LI,LO | |
32847 | COMMON /POINOU/ LI,LO | |
32848 | C event debugging information | |
32849 | INTEGER NMAXD | |
32850 | PARAMETER (NMAXD=100) | |
32851 | INTEGER IDEB,KSPOM,KHPOM,KSREG,KHDIR,KACCEP,KSTRG,KHTRG,KSLOO, | |
32852 | & KHLOO,KSDPO,KHDPO,KEVENT,KSOFT,KHARD | |
32853 | COMMON /PODEBG/ IDEB(NMAXD),KSPOM,KHPOM,KSREG,KHDIR,KACCEP,KSTRG, | |
32854 | & KHTRG,KSLOO,KHLOO,KSDPO,KHDPO,KEVENT,KSOFT,KHARD | |
32855 | C particle ID translation table | |
32856 | integer ID_pdg_list,ID_list,ID_pdg_max | |
32857 | character*12 name_list | |
32858 | COMMON /POPAR1/ ID_pdg_list(300),ID_list(577),name_list(300), | |
32859 | & ID_pdg_max | |
32860 | C general particle data | |
32861 | double precision xm_list,tau_list,gam_list, | |
32862 | & xm_psm2_list,xm_vem2_list,xm_b82_list,xm_b102_list, | |
32863 | & xm_bb82_list,xm_bb102_list | |
32864 | integer ich3_list,iba3_list,iq_list, | |
32865 | & id_psm_list,id_vem_list,id_b8_list,id_b10_list | |
32866 | COMMON /POPAR2/ xm_list(300),tau_list(300),gam_list(300), | |
32867 | & xm_psm2_list(6,6),xm_vem2_list(6,6), | |
32868 | & xm_b82_list(6,6,6),xm_b102_list(6,6,6), | |
32869 | & xm_bb82_list(6,6,6,6),xm_bb102_list(6,6,6,6), | |
32870 | & ich3_list(300),iba3_list(300),iq_list(3,300), | |
32871 | & id_psm_list(6,6),id_vem_list(6,6), | |
32872 | & id_b8_list(6,6,6),id_b10_list(6,6,6) | |
32873 | ||
32874 | C local variables | |
32875 | integer ii,jj,kk | |
32876 | ||
32877 | C find particle ID's | |
32878 | ii = iabs(I) | |
32879 | jj = iabs(J) | |
32880 | kk = iabs(K) | |
32881 | I8 = id_b8_list(ii,jj,kk) | |
32882 | I10 = id_b10_list(ii,jj,kk) | |
32883 | ||
32884 | C masses (if combination possible) | |
32885 | if(I8.ne.0) then | |
32886 | AM8 = xm_list(I8) | |
32887 | I8 = sign(I8,i) | |
32888 | else | |
32889 | AM8 = 0.D0 | |
32890 | endif | |
32891 | if(I10.ne.0) then | |
32892 | AM10 = xm_list(I10) | |
32893 | I10 = sign(I10,i) | |
32894 | else | |
32895 | AM10 = 0.D0 | |
32896 | endif | |
32897 | ||
32898 | C next possible two-particle configurations (add phase space) | |
32899 | AM82 = xm_b82_list(ii,jj,kk)*1.5D0 | |
32900 | AM102 = xm_b102_list(ii,jj,kk)*1.1D0 | |
32901 | ||
32902 | END | |
32903 | ||
32904 | *$ CREATE PHO_DQMASS.FOR | |
32905 | *COPY PHO_DQMASS | |
32906 | CDECK ID>, PHO_DQMASS | |
32907 | SUBROUTINE PHO_DQMASS(I,J,K,L,AM82,AM102) | |
32908 | C********************************************************************** | |
32909 | C | |
32910 | C determine minimal masses corresponding to the input flavours | |
32911 | C (diquark a-diquark string system) | |
32912 | C | |
32913 | C input: I,J,K,L quark flavours (PDG convention) | |
32914 | C | |
32915 | C output: AM82 mass of two octett baryons | |
32916 | C AM102 mass of two decuplett baryons | |
32917 | C | |
32918 | C********************************************************************** | |
32919 | IMPLICIT NONE | |
32920 | SAVE | |
32921 | ||
32922 | integer I,J,K,L | |
32923 | double precision AM82,AM102 | |
32924 | ||
32925 | C input/output channels | |
32926 | INTEGER LI,LO | |
32927 | COMMON /POINOU/ LI,LO | |
32928 | C event debugging information | |
32929 | INTEGER NMAXD | |
32930 | PARAMETER (NMAXD=100) | |
32931 | INTEGER IDEB,KSPOM,KHPOM,KSREG,KHDIR,KACCEP,KSTRG,KHTRG,KSLOO, | |
32932 | & KHLOO,KSDPO,KHDPO,KEVENT,KSOFT,KHARD | |
32933 | COMMON /PODEBG/ IDEB(NMAXD),KSPOM,KHPOM,KSREG,KHDIR,KACCEP,KSTRG, | |
32934 | & KHTRG,KSLOO,KHLOO,KSDPO,KHDPO,KEVENT,KSOFT,KHARD | |
32935 | C general particle data | |
32936 | double precision xm_list,tau_list,gam_list, | |
32937 | & xm_psm2_list,xm_vem2_list,xm_b82_list,xm_b102_list, | |
32938 | & xm_bb82_list,xm_bb102_list | |
32939 | integer ich3_list,iba3_list,iq_list, | |
32940 | & id_psm_list,id_vem_list,id_b8_list,id_b10_list | |
32941 | COMMON /POPAR2/ xm_list(300),tau_list(300),gam_list(300), | |
32942 | & xm_psm2_list(6,6),xm_vem2_list(6,6), | |
32943 | & xm_b82_list(6,6,6),xm_b102_list(6,6,6), | |
32944 | & xm_bb82_list(6,6,6,6),xm_bb102_list(6,6,6,6), | |
32945 | & ich3_list(300),iba3_list(300),iq_list(3,300), | |
32946 | & id_psm_list(6,6),id_vem_list(6,6), | |
32947 | & id_b8_list(6,6,6),id_b10_list(6,6,6) | |
32948 | ||
32949 | C local variables | |
32950 | integer ii,jj,kk,ll | |
32951 | ||
32952 | ii = iabs(i) | |
32953 | kk = iabs(k) | |
32954 | jj = iabs(j) | |
32955 | ll = iabs(l) | |
32956 | ||
32957 | AM82 = xm_bb82_list(ii,jj,kk,ll) | |
32958 | AM102 = xm_bb102_list(ii,jj,kk,ll) | |
32959 | ||
32960 | END | |
32961 | ||
32962 | *$ CREATE PHO_CHECK.FOR | |
32963 | *COPY PHO_CHECK | |
32964 | CDECK ID>, PHO_CHECK | |
32965 | SUBROUTINE PHO_CHECK(MD,IDEV) | |
32966 | C********************************************************************** | |
32967 | C | |
32968 | C check quantum numbers of entries in /POEVT1/ and /POEVT2/ | |
32969 | C (energy, momentum, charge, baryon number conservation) | |
32970 | C | |
32971 | C input: MD -1 check overall momentum conservation | |
32972 | C and perform detailed check only in case of | |
32973 | C deviations | |
32974 | C 1 test all branchings, mother-daughter | |
32975 | C relations | |
32976 | C | |
32977 | C output: IDEV 0 no deviations | |
32978 | C 1 deviations found | |
32979 | C | |
32980 | C********************************************************************** | |
32981 | IMPLICIT DOUBLE PRECISION (A-H,O-Z) | |
32982 | SAVE | |
32983 | ||
32984 | C input/output channels | |
32985 | INTEGER LI,LO | |
32986 | COMMON /POINOU/ LI,LO | |
32987 | C event debugging information | |
32988 | INTEGER NMAXD | |
32989 | PARAMETER (NMAXD=100) | |
32990 | INTEGER IDEB,KSPOM,KHPOM,KSREG,KHDIR,KACCEP,KSTRG,KHTRG,KSLOO, | |
32991 | & KHLOO,KSDPO,KHDPO,KEVENT,KSOFT,KHARD | |
32992 | COMMON /PODEBG/ IDEB(NMAXD),KSPOM,KHPOM,KSREG,KHDIR,KACCEP,KSTRG, | |
32993 | & KHTRG,KSLOO,KHLOO,KSDPO,KHDPO,KEVENT,KSOFT,KHARD | |
32994 | C model switches and parameters | |
32995 | CHARACTER*8 MDLNA | |
32996 | INTEGER ISWMDL,IPAMDL | |
32997 | DOUBLE PRECISION PARMDL | |
32998 | COMMON /POMDLS/ MDLNA(50),ISWMDL(50),PARMDL(400),IPAMDL(400) | |
32999 | C global event kinematics and particle IDs | |
33000 | INTEGER IFPAP,IFPAB | |
33001 | DOUBLE PRECISION ECM,PCM,PMASS,PVIRT | |
33002 | COMMON /POGCMS/ ECM,PCM,PMASS(2),PVIRT(2),IFPAP(2),IFPAB(2) | |
33003 | C nucleon-nucleus / nucleus-nucleus interface to DPMJET | |
33004 | INTEGER IDEQP,IDEQB,IHFLD,IHFLS | |
33005 | DOUBLE PRECISION ECMN,PCMN,SECM,SPCM,XPSUB,XTSUB | |
33006 | COMMON /POHDFL/ ECMN,PCMN,SECM,SPCM,XPSUB,XTSUB, | |
33007 | & IDEQP(2),IDEQB(2),IHFLD(2,2),IHFLS(2) | |
33008 | C standard particle data interface | |
33009 | INTEGER NMXHEP | |
33010 | PARAMETER (NMXHEP=4000) | |
33011 | INTEGER NEVHEP,NHEP,ISTHEP,IDHEP,JMOHEP,JDAHEP | |
33012 | DOUBLE PRECISION PHEP,VHEP | |
33013 | COMMON /POEVT1/ NEVHEP,NHEP,ISTHEP(NMXHEP),IDHEP(NMXHEP), | |
33014 | & JMOHEP(2,NMXHEP),JDAHEP(2,NMXHEP),PHEP(5,NMXHEP), | |
33015 | & VHEP(4,NMXHEP) | |
33016 | C extension to standard particle data interface (PHOJET specific) | |
33017 | INTEGER IMPART,IPHIST,ICOLOR | |
33018 | COMMON /POEVT2/ IMPART(NMXHEP),IPHIST(2,NMXHEP),ICOLOR(2,NMXHEP) | |
33019 | C color string configurations including collapsed strings and hadrons | |
33020 | INTEGER MSTR | |
33021 | PARAMETER (MSTR=500) | |
33022 | INTEGER NPOS,NCODE,IPAR1,IPAR2,IPAR3,IPAR4,NNCH,IBHAD | |
33023 | COMMON /POSTRG/ NPOS(4,MSTR),NCODE(MSTR), | |
33024 | & IPAR1(MSTR),IPAR2(MSTR),IPAR3(MSTR),IPAR4(MSTR), | |
33025 | & NNCH(MSTR),IBHAD(MSTR),ISTR | |
33026 | ||
33027 | C count number of errors to avoid disk overflow | |
33028 | DATA IERR / 0 / | |
33029 | ||
33030 | IDEV = 0 | |
33031 | C conservation check suppressed | |
33032 | IF((IPAMDL(15).EQ.0).OR.(IDEB(20).LE.-10)) RETURN | |
33033 | ||
33034 | IF(IPAMDL(13).GT.0) THEN | |
33035 | ||
33036 | C DPMJET call with x limitations | |
33037 | MODE = -1 | |
33038 | ECM1 = SQRT(XPSUB*XTSUB)*ECM | |
33039 | ||
33040 | ELSE | |
33041 | ||
33042 | C standard call | |
33043 | MODE = MD | |
33044 | C first two entries are considered as scattering particles | |
33045 | EE1 = PHEP(4,1) + PHEP(4,2) | |
33046 | PX1 = PHEP(1,1) + PHEP(1,2) | |
33047 | PY1 = PHEP(2,1) + PHEP(2,2) | |
33048 | PZ1 = PHEP(3,1) + PHEP(3,2) | |
33049 | ||
33050 | ENDIF | |
33051 | ||
33052 | DDREL = PARMDL(75) | |
33053 | DDABS = PARMDL(76) | |
33054 | IF(MODE.EQ.-1) GOTO 500 | |
33055 | ||
33056 | 50 CONTINUE | |
33057 | ||
33058 | I = 1 | |
33059 | 100 CONTINUE | |
33060 | ||
33061 | C recognize only decayed particles as mothers | |
33062 | IF(ISTHEP(I).EQ.2) THEN | |
33063 | C search for other mother particles | |
33064 | K = JDAHEP(1,I) | |
33065 | IF(K.EQ.0) THEN | |
33066 | IF(IPAMDL(178).NE.0) | |
33067 | & WRITE(LO,'(1X,2A,I4)') 'PHO_CHECK: ', | |
33068 | & 'entry marked as decayed but no dauther given:',I | |
33069 | GOTO 99 | |
33070 | ENDIF | |
33071 | K1 = JMOHEP(1,K) | |
33072 | K2 = JMOHEP(2,K) | |
33073 | C sum over mother particles | |
33074 | ICH1 = IPHO_CHR3(K1,2) | |
33075 | IBA1 = IPHO_BAR3(K1,2) | |
33076 | EE1 = PHEP(4,K1) | |
33077 | PX1 = PHEP(1,K1) | |
33078 | PY1 = PHEP(2,K1) | |
33079 | PZ1 = PHEP(3,K1) | |
33080 | IF(K2.LT.0) THEN | |
33081 | K2 = -K2 | |
33082 | IF((K1.GT.I).OR.(K2.LT.I)) THEN | |
33083 | WRITE(LO,'(/,1X,2A,3I4)') 'PHO_CHECK: ', | |
33084 | & 'inconsistent mother/daughter relation found',I,K1,K2 | |
33085 | CALL PHO_PREVNT(-1) | |
33086 | ENDIF | |
33087 | DO 400 II=K1+1,K2 | |
33088 | IF(ABS(ISTHEP(II)).LE.2) THEN | |
33089 | ICH1 = ICH1 + IPHO_CHR3(II,2) | |
33090 | IBA1 = IBA1 + IPHO_BAR3(II,2) | |
33091 | EE1 = EE1 + PHEP(4,II) | |
33092 | PX1 = PX1 + PHEP(1,II) | |
33093 | PY1 = PY1 + PHEP(2,II) | |
33094 | PZ1 = PZ1 + PHEP(3,II) | |
33095 | ENDIF | |
33096 | 400 CONTINUE | |
33097 | ELSE IF((K2.GT.0).AND.(K2.NE.K1)) THEN | |
33098 | ICH1 = ICH1 + IPHO_CHR3(K2,2) | |
33099 | IBA1 = IBA1 + IPHO_BAR3(K2,2) | |
33100 | EE1 = EE1 + PHEP(4,K2) | |
33101 | PX1 = PX1 + PHEP(1,K2) | |
33102 | PY1 = PY1 + PHEP(2,K2) | |
33103 | PZ1 = PZ1 + PHEP(3,K2) | |
33104 | ENDIF | |
33105 | ||
33106 | C sum over daughter particles | |
33107 | ICH2 = 0.D0 | |
33108 | IBA2 = 0.D0 | |
33109 | EE2 = 0.D0 | |
33110 | PX2 = 0.D0 | |
33111 | PY2 = 0.D0 | |
33112 | PZ2 = 0.D0 | |
33113 | DO 200 II=JDAHEP(1,I),JDAHEP(2,I) | |
33114 | IF(ABS(ISTHEP(II)).LE.2) THEN | |
33115 | ICH2 = ICH2 + IPHO_CHR3(II,2) | |
33116 | IBA2 = IBA2 + IPHO_BAR3(II,2) | |
33117 | EE2 = EE2 + PHEP(4,II) | |
33118 | PX2 = PX2 + PHEP(1,II) | |
33119 | PY2 = PY2 + PHEP(2,II) | |
33120 | PZ2 = PZ2 + PHEP(3,II) | |
33121 | ENDIF | |
33122 | 200 CONTINUE | |
33123 | ||
33124 | C conservation check | |
33125 | ESC = MAX(MAX(EE1,EE2)*DDREL,DDABS) | |
33126 | IF(ABS(EE1-EE2).GT.ESC) THEN | |
33127 | WRITE(LO,'(1X,A,/,5X,A,I3,2X,1P,2E10.3)') | |
33128 | & 'PHO_CHECK: energy conservation violated for', | |
33129 | & 'entry,initial,final:',I,EE1,EE2 | |
33130 | IDEV = 1 | |
33131 | ENDIF | |
33132 | ESC = MAX(MAX(ABS(PX1),ABS(PX2))*DDREL,DDABS) | |
33133 | IF(ABS(PX1-PX2).GT.ESC) THEN | |
33134 | WRITE(LO,'(1X,A,/,5X,A,I3,2X,1P,2E12.3)') | |
33135 | & 'PHO_CHECK: x-momentum conservation violated for', | |
33136 | & 'entry,initial,final:',I,PX1,PX2 | |
33137 | IDEV = 1 | |
33138 | ENDIF | |
33139 | ESC = MAX(MAX(ABS(PY1),ABS(PY2))*DDREL,DDABS) | |
33140 | IF(ABS(PY1-PY2).GT.ESC) THEN | |
33141 | WRITE(LO,'(1X,A,/,5X,A,I3,2X,1P,2E12.3)') | |
33142 | & 'PHO_CHECK: y-momentum conservation violated for', | |
33143 | & 'entry,initial,final:',I,PY1,PY2 | |
33144 | IDEV = 1 | |
33145 | ENDIF | |
33146 | ESC = MAX(MAX(ABS(PZ1),ABS(PZ2))*DDREL,DDABS) | |
33147 | IF(ABS(PZ1-PZ2).GT.ESC) THEN | |
33148 | WRITE(LO,'(1X,A,/,5X,A,I3,2X,1P,2E12.3)') | |
33149 | & 'PHO_CHECK: z-momentum conservation violated for', | |
33150 | & 'entry,initial,final:',I,PZ1,PZ2 | |
33151 | IDEV = 1 | |
33152 | ENDIF | |
33153 | IF(ICH1.NE.ICH2) THEN | |
33154 | WRITE(LO,'(1X,A,/,5X,A,I3,2X,2I5)') | |
33155 | & 'PHO_CHECK: charge conservation violated for', | |
33156 | & 'entry,initial,final:',I,ICH1,ICH2 | |
33157 | IDEV = 1 | |
33158 | ENDIF | |
33159 | IF(IBA1.NE.IBA2) THEN | |
33160 | WRITE(LO,'(1X,2A,/,5X,A,I3,2X,2I5)') 'PHO_CHECK: ', | |
33161 | & 'baryon charge conservation violated for', | |
33162 | & 'entry,initial,final:',I,IBA1,IBA2 | |
33163 | IDEV = 1 | |
33164 | ENDIF | |
33165 | IF(IDEB(20).GE.35) THEN | |
33166 | WRITE(LO, | |
33167 | & '(/,1X,A,A,2(2X,I4,A,I4),2(/,5X,A,4E13.4),/5X,A,4I5)') | |
33168 | & 'PHO_CHECK diagnostics:', | |
33169 | & '(1.mother/l.mother,1.daughter/l.daughter):', | |
33170 | & K1,'/',K2,JDAHEP(1,I),'/',JDAHEP(2,I), | |
33171 | & 'mother momenta ',PX1,PY1,PZ1,EE1, | |
33172 | & 'daughter momenta ',PX2,PY2,PZ2,EE2, | |
33173 | & 'charge,baryon no ',ICH1,ICH2,IBA1,IBA2 | |
33174 | ENDIF | |
33175 | ENDIF | |
33176 | 99 CONTINUE | |
33177 | I = I+1 | |
33178 | IF(I.LE.NHEP) GOTO 100 | |
33179 | ||
33180 | 55 CONTINUE | |
33181 | ||
33182 | IERR = IERR+IDEV | |
33183 | ||
33184 | C write complete event in case of deviations | |
33185 | IF((IDEB(20).GE.0).AND.(IDEV.NE.0)) THEN | |
33186 | CALL PHO_PREVNT(1) | |
33187 | IF(ISTR.GT.0) THEN | |
33188 | CALL PHO_PRSTRG | |
33189 | IF(ISWMDL(6).GE.0) CALL PYLIST(1) | |
33190 | ENDIF | |
33191 | ENDIF | |
33192 | ||
33193 | C stop after too many errors | |
33194 | IF(IERR.GT.IPAMDL(179)) THEN | |
33195 | WRITE(LO,'(////1X,2A,I6,////)') 'PHO_CHECK:ERROR:', | |
33196 | & 'too many inconsistencies found, program terminated',IERR | |
33197 | CALL PHO_ABORT | |
33198 | ENDIF | |
33199 | ||
33200 | RETURN | |
33201 | ||
33202 | C overall check only (less time consuming) | |
33203 | ||
33204 | 500 CONTINUE | |
33205 | ||
33206 | ICH2 = 0.D0 | |
33207 | IBA2 = 0.D0 | |
33208 | EE2 = 0.D0 | |
33209 | PX2 = 0.D0 | |
33210 | PY2 = 0.D0 | |
33211 | PZ2 = 0.D0 | |
33212 | ||
33213 | DO 300 K=3,NHEP | |
33214 | C recognize only existing particles as possible daughters | |
33215 | IF(ABS(ISTHEP(K)).EQ.1) THEN | |
33216 | ICH2 = ICH2 + IPHO_CHR3(K,2) | |
33217 | IBA2 = IBA2 + IPHO_BAR3(K,2) | |
33218 | EE2 = EE2 + PHEP(4,K) | |
33219 | PX2 = PX2 + PHEP(1,K) | |
33220 | PY2 = PY2 + PHEP(2,K) | |
33221 | PZ2 = PZ2 + PHEP(3,K) | |
33222 | ENDIF | |
33223 | 300 CONTINUE | |
33224 | ||
33225 | C check energy-momentum conservation | |
33226 | ESC = ECM*DDREL | |
33227 | ||
33228 | IF(IPAMDL(13).GT.0) THEN | |
33229 | ||
33230 | C DPMJET call with x limitations | |
33231 | ECM2 = SQRT((EE2-PZ2)*(EE2+PZ2)-PX2**2-PY2**2) | |
33232 | IF(ABS(ECM1-ECM2).GT.ESC) THEN | |
33233 | WRITE(LO,'(1X,A,/,5X,A,1P,2E12.4)') | |
33234 | & 'PHO_CHECK: c.m. energy conservation violated', | |
33235 | & 'initial/final energy:',ECM1,ECM2 | |
33236 | IDEV = 1 | |
33237 | ENDIF | |
33238 | ||
33239 | ELSE | |
33240 | ||
33241 | C standard call | |
33242 | IF(ABS(EE1-EE2).GT.ESC) THEN | |
33243 | WRITE(LO,'(1X,A,/,5X,A,1P,2E12.4)') | |
33244 | & 'PHO_CHECK: energy conservation violated', | |
33245 | & 'initial/final energy:',EE1,EE2 | |
33246 | IDEV = 1 | |
33247 | ENDIF | |
33248 | IF(ABS(PX1-PX2).GT.ESC) THEN | |
33249 | WRITE(LO,'(1X,A,/,5X,A,1P,2E12.4)') | |
33250 | & 'PHO_CHECK: x-momentum conservation violated', | |
33251 | & 'initial/final x-momentum:',PX1,PX2 | |
33252 | IDEV = 1 | |
33253 | ENDIF | |
33254 | IF(ABS(PY1-PY2).GT.ESC) THEN | |
33255 | WRITE(LO,'(1X,A,/,5X,A,1P,2E12.4)') | |
33256 | & 'PHO_CHECK: y-momentum conservation violated', | |
33257 | & 'initial/final y-momentum:',PY1,PY2 | |
33258 | IDEV = 1 | |
33259 | ENDIF | |
33260 | IF(ABS(PZ1-PZ2).GT.ESC) THEN | |
33261 | WRITE(LO,'(1X,A,/,5X,A,1P,2E12.4)') | |
33262 | & 'PHO_CHECK: z-momentum conservation violated', | |
33263 | & 'initial/final z-momentum:',PZ1,PZ2 | |
33264 | IDEV = 1 | |
33265 | ENDIF | |
33266 | ||
33267 | C check of quantum number conservation | |
33268 | ||
33269 | ICH1 = IPHO_CHR3(1,2) + IPHO_CHR3(2,2) | |
33270 | IBA1 = IPHO_BAR3(1,2) + IPHO_BAR3(2,2) | |
33271 | ||
33272 | IF(ICH1.NE.ICH2) THEN | |
33273 | WRITE(LO,'(1X,A,/,5X,A,2I5)') | |
33274 | & 'PHO_CHECK: charge conservation violated', | |
33275 | & 'initial/final charge sum',ICH1,ICH2 | |
33276 | IDEV = 1 | |
33277 | ENDIF | |
33278 | IF(IBA1.NE.IBA2) THEN | |
33279 | WRITE(LO,'(1X,2A,/,5X,A,2I5)') 'PHO_CHECK: ', | |
33280 | & 'baryonic charge conservation violated', | |
33281 | & 'initial/final baryonic charge sum',IBA1,IBA2 | |
33282 | IDEV = 1 | |
33283 | ENDIF | |
33284 | ||
33285 | ENDIF | |
33286 | ||
33287 | C perform detailed checks in case of deviations | |
33288 | IF((IDEB(20).GE.0).AND.(IDEV.NE.0)) THEN | |
33289 | IF(IPAMDL(13).GT.0) THEN | |
33290 | GOTO 55 | |
33291 | ELSE | |
33292 | DDREL = DDREL/2.D0 | |
33293 | DDABS = DDABS/2.D0 | |
33294 | WRITE(LO,'(/1X,2A,2E12.4)') 'PHO_CHECK: ', | |
33295 | & 'increasing precision of tests to',DDREL,DDABS | |
33296 | GOTO 50 | |
33297 | ENDIF | |
33298 | ENDIF | |
33299 | ||
33300 | END | |
33301 | ||
33302 | *$ CREATE PHO_ABORT.FOR | |
33303 | *COPY PHO_ABORT | |
33304 | CDECK ID>, PHO_ABORT | |
33305 | SUBROUTINE PHO_ABORT | |
33306 | C********************************************************************** | |
33307 | C | |
33308 | C top MC event generation due to fatal error, | |
33309 | C print all information of event generation and history | |
33310 | C | |
33311 | C********************************************************************** | |
33312 | IMPLICIT DOUBLE PRECISION (A-H,O-Z) | |
33313 | SAVE | |
33314 | ||
33315 | C input/output channels | |
33316 | INTEGER LI,LO | |
33317 | COMMON /POINOU/ LI,LO | |
33318 | C event debugging information | |
33319 | INTEGER NMAXD | |
33320 | PARAMETER (NMAXD=100) | |
33321 | INTEGER IDEB,KSPOM,KHPOM,KSREG,KHDIR,KACCEP,KSTRG,KHTRG,KSLOO, | |
33322 | & KHLOO,KSDPO,KHDPO,KEVENT,KSOFT,KHARD | |
33323 | COMMON /PODEBG/ IDEB(NMAXD),KSPOM,KHPOM,KSREG,KHDIR,KACCEP,KSTRG, | |
33324 | & KHTRG,KSLOO,KHLOO,KSDPO,KHDPO,KEVENT,KSOFT,KHARD | |
33325 | C model switches and parameters | |
33326 | CHARACTER*8 MDLNA | |
33327 | INTEGER ISWMDL,IPAMDL | |
33328 | DOUBLE PRECISION PARMDL | |
33329 | COMMON /POMDLS/ MDLNA(50),ISWMDL(50),PARMDL(400),IPAMDL(400) | |
33330 | C standard particle data interface | |
33331 | INTEGER NMXHEP | |
33332 | PARAMETER (NMXHEP=4000) | |
33333 | INTEGER NEVHEP,NHEP,ISTHEP,IDHEP,JMOHEP,JDAHEP | |
33334 | DOUBLE PRECISION PHEP,VHEP | |
33335 | COMMON /POEVT1/ NEVHEP,NHEP,ISTHEP(NMXHEP),IDHEP(NMXHEP), | |
33336 | & JMOHEP(2,NMXHEP),JDAHEP(2,NMXHEP),PHEP(5,NMXHEP), | |
33337 | & VHEP(4,NMXHEP) | |
33338 | C extension to standard particle data interface (PHOJET specific) | |
33339 | INTEGER IMPART,IPHIST,ICOLOR | |
33340 | COMMON /POEVT2/ IMPART(NMXHEP),IPHIST(2,NMXHEP),ICOLOR(2,NMXHEP) | |
33341 | C color string configurations including collapsed strings and hadrons | |
33342 | INTEGER MSTR | |
33343 | PARAMETER (MSTR=500) | |
33344 | INTEGER NPOS,NCODE,IPAR1,IPAR2,IPAR3,IPAR4,NNCH,IBHAD | |
33345 | COMMON /POSTRG/ NPOS(4,MSTR),NCODE(MSTR), | |
33346 | & IPAR1(MSTR),IPAR2(MSTR),IPAR3(MSTR),IPAR4(MSTR), | |
33347 | & NNCH(MSTR),IBHAD(MSTR),ISTR | |
33348 | C light-cone x fractions and c.m. momenta of soft cut string ends | |
33349 | INTEGER MAXSOF | |
33350 | PARAMETER ( MAXSOF = 50 ) | |
33351 | INTEGER IJSI2,IJSI1 | |
33352 | DOUBLE PRECISION XS1,XS2,PSOFT1,PSOFT2 | |
33353 | COMMON /POSOFT/ XS1(MAXSOF),XS2(MAXSOF), | |
33354 | & PSOFT1(4,MAXSOF),PSOFT2(4,MAXSOF), | |
33355 | & IJSI1(MAXSOF),IJSI2(MAXSOF) | |
33356 | C hard scattering data | |
33357 | INTEGER MSCAHD | |
33358 | PARAMETER ( MSCAHD = 50 ) | |
33359 | INTEGER LSCAHD,LSC1HD,LSIDX, | |
33360 | & NINHD,N0INHD,NIVAL,N0IVAL,NOUTHD,NBRAHD,NPROHD | |
33361 | DOUBLE PRECISION PPH,PTHD,ETAHD,Q2SCA,PDFVA,XHD,VHD,X0HD | |
33362 | COMMON /POHSLT/ LSCAHD,LSC1HD,LSIDX(MSCAHD), | |
33363 | & PPH(8*MSCAHD,2),PTHD(MSCAHD),ETAHD(MSCAHD,2), | |
33364 | & Q2SCA(MSCAHD,2),PDFVA(MSCAHD,2), | |
33365 | & XHD(MSCAHD,2),VHD(MSCAHD),X0HD(MSCAHD,2), | |
33366 | & NINHD(MSCAHD,2),N0INHD(MSCAHD,2), | |
33367 | & NIVAL(MSCAHD,2),N0IVAL(MSCAHD,2), | |
33368 | & NOUTHD(MSCAHD,2),NBRAHD(MSCAHD,2),NPROHD(MSCAHD) | |
33369 | ||
33370 | WRITE(LO,'(//,1X,A,/,1X,A)') | |
33371 | & 'PHO_ABORT: program execution stopped', | |
33372 | & '====================================' | |
33373 | WRITE(LO,'(/,1X,A,/,1X,A)') 'listing of available data follows:' | |
33374 | C | |
33375 | CALL PHO_SETMDL(0,0,-2) | |
33376 | CALL PHO_PREVNT(-1) | |
33377 | CALL PHO_ACTPDF(0,-2) | |
33378 | C print selected parton flavours | |
33379 | WRITE(LO,'(1X,A,I4)') 'selected soft flavours: ',KSOFT | |
33380 | DO 700 I=1,KSOFT | |
33381 | WRITE(LO,'(10X,2I5)') IJSI1(I),IJSI2(I) | |
33382 | 700 CONTINUE | |
33383 | WRITE(LO,'(1X,A,I4)') 'selected hard flavours: ',KHARD | |
33384 | DO 750 K=1,KHARD | |
33385 | I = LSIDX(K) | |
33386 | WRITE(LO,'(10X,A,I5)') 'process:',NPROHD(I) | |
33387 | WRITE(LO,'(10X,A,2I4,7X,A,2I4)') 'initial:',NINHD(I,1), | |
33388 | & NINHD(I,2),'final:',NOUTHD(I,1),NOUTHD(I,2) | |
33389 | 750 CONTINUE | |
33390 | C print selected parton momenta | |
33391 | WRITE(LO,'(1X,A,I4)') 'selected soft momenta: ',KSOFT | |
33392 | DO 300 I=1,KSOFT | |
33393 | WRITE(LO,'(10X,A,4E12.3)') 'par.1',(PSOFT1(II,I),II=1,4) | |
33394 | WRITE(LO,'(10X,A,4E12.3)') 'par.2',(PSOFT2(II,I),II=1,4) | |
33395 | 300 CONTINUE | |
33396 | WRITE(LO,'(1X,A,I4)') 'selected hard momenta: ',KHARD | |
33397 | DO 350 K=1,KHARD | |
33398 | I = LSIDX(K) | |
33399 | I3 = 8*I-4 | |
33400 | WRITE(LO,'(10X,A,4E12.3)') 'par.1',(PPH(I3+II,1),II=1,4) | |
33401 | WRITE(LO,'(10X,A,4E12.3)') 'par.2',(PPH(I3+II,2),II=1,4) | |
33402 | 350 CONTINUE | |
33403 | ||
33404 | C print /POEVT1/ | |
33405 | CALL PHO_PREVNT(0) | |
33406 | ||
33407 | C fragmentation process | |
33408 | IF(ISTR.GT.0) THEN | |
33409 | C print /POSTRG/ | |
33410 | CALL PHO_PRSTRG | |
33411 | IF(ISWMDL(6).GE.0) CALL PYLIST(1) | |
33412 | ENDIF | |
33413 | ||
33414 | C last message | |
33415 | WRITE(LO,'(////5X,A,///5X,A,///)') | |
33416 | & 'PHO_ABORT: execution terminated due to fatal error', | |
33417 | &'*** Simulating division by zero to get traceback information ***' | |
33418 | ISTR = 100/IPAMDL(100) | |
33419 | ||
33420 | END | |
33421 | ||
33422 | *$ CREATE PHO_TRACE.FOR | |
33423 | *COPY PHO_TRACE | |
33424 | CDECK ID>, PHO_TRACE | |
33425 | SUBROUTINE PHO_TRACE(ISTART,ISWI,LEVEL) | |
33426 | C********************************************************************** | |
33427 | C | |
33428 | C trace program subroutines according to level, | |
33429 | C original output levels will be saved | |
33430 | C | |
33431 | C input: ISTART first event to trace | |
33432 | C ISWI number of events to trace | |
33433 | C 0 loop call, use old values | |
33434 | C -1 restore original output levels | |
33435 | C 1 store level and wait for event | |
33436 | C LEVEL desired output level | |
33437 | C 0 standard output | |
33438 | C 3 internal rejections | |
33439 | C 5 cross sections, slopes etc. | |
33440 | C 10 parameter of subroutines and | |
33441 | C results | |
33442 | C 20 huge amount of debug output | |
33443 | C 30 maximal possible output | |
33444 | C | |
33445 | C********************************************************************** | |
33446 | IMPLICIT DOUBLE PRECISION (A-H,O-Z) | |
33447 | SAVE | |
33448 | ||
33449 | C input/output channels | |
33450 | INTEGER LI,LO | |
33451 | COMMON /POINOU/ LI,LO | |
33452 | C event debugging information | |
33453 | INTEGER NMAXD | |
33454 | PARAMETER (NMAXD=100) | |
33455 | INTEGER IDEB,KSPOM,KHPOM,KSREG,KHDIR,KACCEP,KSTRG,KHTRG,KSLOO, | |
33456 | & KHLOO,KSDPO,KHDPO,KEVENT,KSOFT,KHARD | |
33457 | COMMON /PODEBG/ IDEB(NMAXD),KSPOM,KHPOM,KSREG,KHDIR,KACCEP,KSTRG, | |
33458 | & KHTRG,KSLOO,KHLOO,KSDPO,KHDPO,KEVENT,KSOFT,KHARD | |
33459 | ||
33460 | DIMENSION IMEM(NMAXD) | |
33461 | ||
33462 | C protect ISWI | |
33463 | ISW = ISWI | |
33464 | 10 CONTINUE | |
33465 | IF(ISW.EQ.0) THEN | |
33466 | IF(KEVENT.LT.ION) THEN | |
33467 | RETURN | |
33468 | ELSE IF(KEVENT.EQ.ION) THEN | |
33469 | WRITE(LO,'(///,1X,A,///)') | |
33470 | & 'PHO_TRACE: trace mode switched on' | |
33471 | DO 100 I=1,NMAXD | |
33472 | IMEM(I) = IDEB(I) | |
33473 | IDEB(I) = MAX(ILEVEL,IMEM(I)) | |
33474 | 100 CONTINUE | |
33475 | ELSE IF(KEVENT.EQ.IOFF) THEN | |
33476 | WRITE(LO,'(//,1X,A,///)') | |
33477 | & 'PHO_TRACE: trace mode switched off' | |
33478 | DO 200 I=1,NMAXD | |
33479 | IDEB(I) = IMEM(I) | |
33480 | 200 CONTINUE | |
33481 | ENDIF | |
33482 | ELSE IF(ISW.EQ.-1) THEN | |
33483 | DO 300 I=1,NMAXD | |
33484 | IDEB(I) = IMEM(I) | |
33485 | 300 CONTINUE | |
33486 | ELSE | |
33487 | C save information | |
33488 | ION = ISTART | |
33489 | IOFF = ISTART+ISW | |
33490 | ILEVEL = LEVEL | |
33491 | ENDIF | |
33492 | C check coincidence | |
33493 | IF(ISW.GT.0) THEN | |
33494 | ISW=0 | |
33495 | ILEVEL = LEVEL | |
33496 | GOTO 10 | |
33497 | ENDIF | |
33498 | ||
33499 | END | |
33500 | ||
33501 | *$ CREATE PHO_PRSTRG.FOR | |
33502 | *COPY PHO_PRSTRG | |
33503 | CDECK ID>, PHO_PRSTRG | |
33504 | SUBROUTINE PHO_PRSTRG | |
33505 | C********************************************************************** | |
33506 | C | |
33507 | C print information of /POSTRG/ | |
33508 | C | |
33509 | C********************************************************************** | |
33510 | IMPLICIT DOUBLE PRECISION (A-H,O-Z) | |
33511 | SAVE | |
33512 | ||
33513 | C input/output channels | |
33514 | INTEGER LI,LO | |
33515 | COMMON /POINOU/ LI,LO | |
33516 | C event debugging information | |
33517 | INTEGER NMAXD | |
33518 | PARAMETER (NMAXD=100) | |
33519 | INTEGER IDEB,KSPOM,KHPOM,KSREG,KHDIR,KACCEP,KSTRG,KHTRG,KSLOO, | |
33520 | & KHLOO,KSDPO,KHDPO,KEVENT,KSOFT,KHARD | |
33521 | COMMON /PODEBG/ IDEB(NMAXD),KSPOM,KHPOM,KSREG,KHDIR,KACCEP,KSTRG, | |
33522 | & KHTRG,KSLOO,KHLOO,KSDPO,KHDPO,KEVENT,KSOFT,KHARD | |
33523 | C standard particle data interface | |
33524 | INTEGER NMXHEP | |
33525 | PARAMETER (NMXHEP=4000) | |
33526 | INTEGER NEVHEP,NHEP,ISTHEP,IDHEP,JMOHEP,JDAHEP | |
33527 | DOUBLE PRECISION PHEP,VHEP | |
33528 | COMMON /POEVT1/ NEVHEP,NHEP,ISTHEP(NMXHEP),IDHEP(NMXHEP), | |
33529 | & JMOHEP(2,NMXHEP),JDAHEP(2,NMXHEP),PHEP(5,NMXHEP), | |
33530 | & VHEP(4,NMXHEP) | |
33531 | C extension to standard particle data interface (PHOJET specific) | |
33532 | INTEGER IMPART,IPHIST,ICOLOR | |
33533 | COMMON /POEVT2/ IMPART(NMXHEP),IPHIST(2,NMXHEP),ICOLOR(2,NMXHEP) | |
33534 | C color string configurations including collapsed strings and hadrons | |
33535 | INTEGER MSTR | |
33536 | PARAMETER (MSTR=500) | |
33537 | INTEGER NPOS,NCODE,IPAR1,IPAR2,IPAR3,IPAR4,NNCH,IBHAD | |
33538 | COMMON /POSTRG/ NPOS(4,MSTR),NCODE(MSTR), | |
33539 | & IPAR1(MSTR),IPAR2(MSTR),IPAR3(MSTR),IPAR4(MSTR), | |
33540 | & NNCH(MSTR),IBHAD(MSTR),ISTR | |
33541 | ||
33542 | WRITE(LO,'(/,1X,A,I5)') | |
33543 | & 'PHO_PRSTRG: number of strings soft+hard:',ISTR | |
33544 | WRITE(LO,'(/,1X,A/,1X,A)') 'COMMON /POSTRG/:', | |
33545 | & ' NOBAM ID1 ID2 ID3 ID4 NPO1/2/3/4 MASS' | |
33546 | WRITE(LO,'(1X,A)') | |
33547 | & ' =======================================================' | |
33548 | DO 800 I=1,ISTR | |
33549 | WRITE(LO,'(1X,9I5,1P,E11.3)') | |
33550 | & NCODE(I),IPAR1(I),IPAR2(I),IPAR3(I),IPAR4(I),NPOS(1,I), | |
33551 | & NPOS(2,I),NPOS(3,I),NPOS(4,I),PHEP(5,NPOS(1,I)) | |
33552 | 800 CONTINUE | |
33553 | ||
33554 | END | |
33555 | ||
33556 | *$ CREATE PHO_PREVNT.FOR | |
33557 | *COPY PHO_PREVNT | |
33558 | CDECK ID>, PHO_PREVNT | |
33559 | SUBROUTINE PHO_PREVNT(NPART) | |
33560 | C********************************************************************** | |
33561 | C | |
33562 | C print all information of event generation and history | |
33563 | C | |
33564 | C input: NPART -1 minimal output: process IDs | |
33565 | C 0 additional output of /POEVT1/ | |
33566 | C 1 additional output of /POSTRG/ | |
33567 | C 2 additional output of /HEPEVT/ | |
33568 | C (call LULIST(1)) | |
33569 | C | |
33570 | C********************************************************************** | |
33571 | IMPLICIT DOUBLE PRECISION (A-H,O-Z) | |
33572 | SAVE | |
33573 | ||
33574 | C input/output channels | |
33575 | INTEGER LI,LO | |
33576 | COMMON /POINOU/ LI,LO | |
33577 | C event debugging information | |
33578 | INTEGER NMAXD | |
33579 | PARAMETER (NMAXD=100) | |
33580 | INTEGER IDEB,KSPOM,KHPOM,KSREG,KHDIR,KACCEP,KSTRG,KHTRG,KSLOO, | |
33581 | & KHLOO,KSDPO,KHDPO,KEVENT,KSOFT,KHARD | |
33582 | COMMON /PODEBG/ IDEB(NMAXD),KSPOM,KHPOM,KSREG,KHDIR,KACCEP,KSTRG, | |
33583 | & KHTRG,KSLOO,KHLOO,KSDPO,KHDPO,KEVENT,KSOFT,KHARD | |
33584 | C model switches and parameters | |
33585 | CHARACTER*8 MDLNA | |
33586 | INTEGER ISWMDL,IPAMDL | |
33587 | DOUBLE PRECISION PARMDL | |
33588 | COMMON /POMDLS/ MDLNA(50),ISWMDL(50),PARMDL(400),IPAMDL(400) | |
33589 | C global event kinematics and particle IDs | |
33590 | INTEGER IFPAP,IFPAB | |
33591 | DOUBLE PRECISION ECM,PCM,PMASS,PVIRT | |
33592 | COMMON /POGCMS/ ECM,PCM,PMASS(2),PVIRT(2),IFPAP(2),IFPAB(2) | |
33593 | C general process information | |
33594 | INTEGER IPROCE,IDNODF,IDIFR1,IDIFR2,IDDPOM,IPRON | |
33595 | COMMON /POPRCS/ IPROCE,IDNODF,IDIFR1,IDIFR2,IDDPOM,IPRON(15,4) | |
33596 | C standard particle data interface | |
33597 | INTEGER NMXHEP | |
33598 | PARAMETER (NMXHEP=4000) | |
33599 | INTEGER NEVHEP,NHEP,ISTHEP,IDHEP,JMOHEP,JDAHEP | |
33600 | DOUBLE PRECISION PHEP,VHEP | |
33601 | COMMON /POEVT1/ NEVHEP,NHEP,ISTHEP(NMXHEP),IDHEP(NMXHEP), | |
33602 | & JMOHEP(2,NMXHEP),JDAHEP(2,NMXHEP),PHEP(5,NMXHEP), | |
33603 | & VHEP(4,NMXHEP) | |
33604 | C extension to standard particle data interface (PHOJET specific) | |
33605 | INTEGER IMPART,IPHIST,ICOLOR | |
33606 | COMMON /POEVT2/ IMPART(NMXHEP),IPHIST(2,NMXHEP),ICOLOR(2,NMXHEP) | |
33607 | C nucleon-nucleus / nucleus-nucleus interface to DPMJET | |
33608 | INTEGER IDEQP,IDEQB,IHFLD,IHFLS | |
33609 | DOUBLE PRECISION ECMN,PCMN,SECM,SPCM,XPSUB,XTSUB | |
33610 | COMMON /POHDFL/ ECMN,PCMN,SECM,SPCM,XPSUB,XTSUB, | |
33611 | & IDEQP(2),IDEQB(2),IHFLD(2,2),IHFLS(2) | |
33612 | ||
33613 | CHARACTER*15 PHO_PNAME | |
33614 | ||
33615 | IF(NPART.GE.0) WRITE(LO,'(/)') | |
33616 | WRITE(LO,'(1X,A,1PE10.3)') | |
33617 | & 'PHO_PREVNT: c.m. energy',ECM | |
33618 | CALL PHO_SETPAR(-2,IH,NPART,0.D0) | |
33619 | WRITE(LO,'(6X,A,A,/1X,I10,10I6)') | |
33620 | & 'EV-CALL,ISPOM,IHPOM,ISREG,IHDIR,KSTRG,', | |
33621 | & 'KHTRG,KSLOO,KHLOO,KSDPO,KHDPO', | |
33622 | & KEVENT,KSPOM,KHPOM,KSREG,KHDIR,KSTRG,KHTRG,KSLOO,KHLOO,KSDPO, | |
33623 | & KHDPO | |
33624 | WRITE(LO,'(6X,A,I4,4I3)') | |
33625 | & 'PROCESS-ID,IDNODF,IDIFF1,IDIFF2,IDDPOM',IPROCE,IDNODF,IDIFR1, | |
33626 | & IDIFR2,IDDPOM | |
33627 | ||
33628 | IF(IPAMDL(13).GT.0) THEN | |
33629 | WRITE(LO,'(1X,A)') 'PHO_PREVNT: DPMJET special settings:' | |
33630 | WRITE(LO,'(5X,A,1P,4E11.3)') 'ECMN,PCMN,SECM,SPCM', | |
33631 | & ECMN,PCMN,SECM,SPCM | |
33632 | WRITE(LO,'(5X,A,1P,2E11.3)') 'XPSUB,XTSUB',XPSUB,XTSUB | |
33633 | ENDIF | |
33634 | ||
33635 | IF(NPART.LT.0) RETURN | |
33636 | ||
33637 | IF(NPART.GE.1) CALL PHO_PRSTRG | |
33638 | ||
33639 | WRITE(LO,'(/1X,A)') 'COMMON /POEVT1/:' | |
33640 | ICHAS = 0 | |
33641 | IBARFS = 0 | |
33642 | IMULC = 0 | |
33643 | IMUL = 0 | |
33644 | WRITE(LO,'(/1X,A,A,/,1X,A,A)') | |
33645 | & ' NO IST NAME MO-1 MO-2 DA-1 DA-2 CHA BAR', | |
33646 | & ' IH1 IH2 CO1 CO2', | |
33647 | & '========================================================', | |
33648 | & '====================' | |
33649 | DO 20 IH=1,NHEP | |
33650 | CH = DBLE(IPHO_CHR3(IH,2)/3.D0) | |
33651 | BA = DBLE(IPHO_BAR3(IH,2)/3.D0) | |
33652 | WRITE(LO,'(1X,2I5,1X,A15,4I5,2F5.1,2I5,2I5)') | |
33653 | & IH,ISTHEP(IH),PHO_PNAME(IH,2), | |
33654 | & JMOHEP(1,IH),JMOHEP(2,IH),JDAHEP(1,IH),JDAHEP(2,IH), | |
33655 | & CH,BA,IPHIST(1,IH),IPHIST(2,IH), | |
33656 | & ICOLOR(1,IH),ICOLOR(2,IH) | |
33657 | IF(ABS(ISTHEP(IH)).EQ.1) THEN | |
33658 | ICHAS = ICHAS + IPHO_CHR3(IH,2) | |
33659 | IBARFS = IBARFS + IPHO_BAR3(IH,2) | |
33660 | ENDIF | |
33661 | IF(ABS(ISTHEP(IH)).EQ.1) THEN | |
33662 | IF(IPHO_CHR3(IH,2).NE.0) IMULC = IMULC+1 | |
33663 | IMUL = IMUL+1 | |
33664 | ENDIF | |
33665 | 20 CONTINUE | |
33666 | WRITE(LO,'(1X,2(3X,A,I3),2X,2(5X,A,I5))') 'sum charge:',ICHAS/3, | |
33667 | & 'baryon:',IBARFS/3,'chr.mult:',IMULC,'tot.mult:',IMUL | |
33668 | ||
33669 | WRITE(LO,7) | |
33670 | PXS = 0.D0 | |
33671 | PYS = 0.D0 | |
33672 | PZS = 0.D0 | |
33673 | P0S = 0.D0 | |
33674 | DO 30 IN=1,NHEP | |
33675 | IF( (ABS(PHEP(3,IN)).LT.99999.D0) | |
33676 | & .AND.(PHEP(4,IN).LT.99999.D0)) THEN | |
33677 | WRITE(LO,8) IN,ISTHEP(IN),PHO_PNAME(IN,2), | |
33678 | & (PHEP(J,IN),J=1,5),SQRT(PHEP(1,IN)**2+PHEP(2,IN)**2) | |
33679 | ELSE | |
33680 | WRITE(LO,11) IN,ISTHEP(IN),PHO_PNAME(IN,2), | |
33681 | & (PHEP(J,IN),J=1,5),SQRT(PHEP(1,IN)**2+PHEP(2,IN)**2) | |
33682 | ENDIF | |
33683 | IF(ABS(ISTHEP(IN)).EQ.1) THEN | |
33684 | PXS = PXS + PHEP(1,IN) | |
33685 | PYS = PYS + PHEP(2,IN) | |
33686 | PZS = PZS + PHEP(3,IN) | |
33687 | P0S = P0S + PHEP(4,IN) | |
33688 | ENDIF | |
33689 | 30 CONTINUE | |
33690 | AMFS = P0S**2-PXS**2-PYS**2-PZS**2 | |
33691 | AMFS = SIGN(SQRT(ABS(AMFS)),AMFS) | |
33692 | IF(P0S.LT.99999.D0) THEN | |
33693 | WRITE(LO,10) ' sum: ',PXS,PYS,PZS,P0S,AMFS | |
33694 | ELSE | |
33695 | WRITE(LO,12) ' sum: ',PXS,PYS,PZS,P0S,AMFS | |
33696 | ENDIF | |
33697 | WRITE(LO,'(//)') | |
33698 | ||
33699 | 5 FORMAT(2X,8H NUMBER ,8H STATUS ,8H IDENT. , | |
33700 | & 8H 1.MOTH.,8H 2.MOTH.,8H 1.DAUG.,8H L.DAUG., | |
33701 | & 8H CHARGE ,8H BARYON ,/) | |
33702 | 6 FORMAT(7I8,2F8.3) | |
33703 | 7 FORMAT(/,2X,' NR STAT NAME X-MOMENTA', | |
33704 | & ' Y-MOMENTA Z-MOMENTA ENERGY MASS PT',/, | |
33705 | & 2X,'-------------------------------', | |
33706 | & '--------------------------------------------') | |
33707 | 8 FORMAT(I5,I4,1X,A15,2F8.3,3F10.3,F8.3) | |
33708 | 9 FORMAT(I10,14X,5F10.3) | |
33709 | 10 FORMAT(10X,A14,1X,2F8.3,3F10.3) | |
33710 | 11 FORMAT(I5,I4,1X,A15,2F8.2,2F10.1,F10.3,F8.3) | |
33711 | 12 FORMAT(10X,A14,1X,2F8.2,2F10.1,F10.3) | |
33712 | ||
33713 | IF(NPART.GE.2) CALL PYLIST(1) | |
33714 | ||
33715 | END | |
33716 | ||
33717 | *$ CREATE PHO_LTRHEP.FOR | |
33718 | *COPY PHO_LTRHEP | |
33719 | CDECK ID>, PHO_LTRHEP | |
33720 | SUBROUTINE PHO_LTRHEP(I1,I2,COD,SID,COF,SIF,GAM,BGX,BGY,BGZ) | |
33721 | C******************************************************************* | |
33722 | C | |
33723 | C Lorentz transformation of entries I1 to I2 in /POEVT1/ | |
33724 | C | |
33725 | C******************************************************************** | |
33726 | IMPLICIT DOUBLE PRECISION (A-H,O-Z) | |
33727 | SAVE | |
33728 | ||
33729 | PARAMETER ( DIFF = 0.001D0, | |
33730 | & EPS = 1.D-5 ) | |
33731 | ||
33732 | C input/output channels | |
33733 | INTEGER LI,LO | |
33734 | COMMON /POINOU/ LI,LO | |
33735 | C event debugging information | |
33736 | INTEGER NMAXD | |
33737 | PARAMETER (NMAXD=100) | |
33738 | INTEGER IDEB,KSPOM,KHPOM,KSREG,KHDIR,KACCEP,KSTRG,KHTRG,KSLOO, | |
33739 | & KHLOO,KSDPO,KHDPO,KEVENT,KSOFT,KHARD | |
33740 | COMMON /PODEBG/ IDEB(NMAXD),KSPOM,KHPOM,KSREG,KHDIR,KACCEP,KSTRG, | |
33741 | & KHTRG,KSLOO,KHLOO,KSDPO,KHDPO,KEVENT,KSOFT,KHARD | |
33742 | C standard particle data interface | |
33743 | INTEGER NMXHEP | |
33744 | PARAMETER (NMXHEP=4000) | |
33745 | INTEGER NEVHEP,NHEP,ISTHEP,IDHEP,JMOHEP,JDAHEP | |
33746 | DOUBLE PRECISION PHEP,VHEP | |
33747 | COMMON /POEVT1/ NEVHEP,NHEP,ISTHEP(NMXHEP),IDHEP(NMXHEP), | |
33748 | & JMOHEP(2,NMXHEP),JDAHEP(2,NMXHEP),PHEP(5,NMXHEP), | |
33749 | & VHEP(4,NMXHEP) | |
33750 | C extension to standard particle data interface (PHOJET specific) | |
33751 | INTEGER IMPART,IPHIST,ICOLOR | |
33752 | COMMON /POEVT2/ IMPART(NMXHEP),IPHIST(2,NMXHEP),ICOLOR(2,NMXHEP) | |
33753 | ||
33754 | DO 100 I=I1,MIN(I2,NHEP) | |
33755 | IF((ABS(ISTHEP(I)).LE.10).OR.(ISTHEP(I).EQ.21)) THEN | |
33756 | CALL PHO_TRANS(PHEP(1,I),PHEP(2,I),PHEP(3,I),COD,SID,COF,SIF, | |
33757 | & XX,YY,ZZ) | |
33758 | EE=PHEP(4,I) | |
33759 | CALL PHO_ALTRA(GAM,BGX,BGY,BGZ,XX,YY,ZZ,EE,PTOT, | |
33760 | & PHEP(1,I),PHEP(2,I),PHEP(3,I),PHEP(4,I)) | |
33761 | ELSE IF(ISTHEP(I).EQ.20) THEN | |
33762 | EE=SQRT(PHEP(1,I)**2+PHEP(2,I)**2+PHEP(3,I)**2) | |
33763 | CALL PHO_TRANS(PHEP(1,I),PHEP(2,I),PHEP(3,I),COD,SID,COF,SIF, | |
33764 | & XX,YY,ZZ) | |
33765 | CALL PHO_ALTRA(GAM,BGX,BGY,BGZ,XX,YY,ZZ,EE,PTOT, | |
33766 | & PHEP(1,I),PHEP(2,I),PHEP(3,I),PMASS) | |
33767 | ENDIF | |
33768 | 100 CONTINUE | |
33769 | ||
33770 | C debug precision | |
33771 | IF(IDEB(70).LT.1) RETURN | |
33772 | DO 200 I=I1,MIN(NHEP,I2) | |
33773 | IF(ABS(ISTHEP(I)).GT.10) GOTO 190 | |
33774 | PMASS = PHEP(4,I)**2-PHEP(1,I)**2-PHEP(2,I)**2-PHEP(3,I)**2 | |
33775 | PMASS = SIGN(SQRT(ABS(PMASS)),PMASS) | |
33776 | IF((ABS(PMASS-PHEP(5,I))/MAX(PHEP(5,I),1.D0)).GT.DIFF) THEN | |
33777 | WRITE(LO,'(1X,A,I5,2E13.4)') | |
33778 | & 'PHO_LTRHEP: inconsistent masses:',I,PMASS,PHEP(5,I) | |
33779 | ENDIF | |
33780 | 190 CONTINUE | |
33781 | 200 CONTINUE | |
33782 | ||
33783 | END | |
33784 | ||
33785 | *$ CREATE PHO_PECMS.FOR | |
33786 | *COPY PHO_PECMS | |
33787 | CDECK ID>, PHO_PECMS | |
33788 | SUBROUTINE PHO_PECMS(ID,PMASS1,PMASS2,ECM,PP,EE) | |
33789 | C******************************************************************* | |
33790 | C | |
33791 | C calculation of cms momentum and energy of massive particle | |
33792 | C (ID= 1 using PMASS1, 2 using PMASS2) | |
33793 | C | |
33794 | C output: PP cms momentum | |
33795 | C EE energy in CMS of particle ID | |
33796 | C | |
33797 | C******************************************************************** | |
33798 | IMPLICIT DOUBLE PRECISION (A-H,O-Z) | |
33799 | SAVE | |
33800 | ||
33801 | C input/output channels | |
33802 | INTEGER LI,LO | |
33803 | COMMON /POINOU/ LI,LO | |
33804 | C event debugging information | |
33805 | INTEGER NMAXD | |
33806 | PARAMETER (NMAXD=100) | |
33807 | INTEGER IDEB,KSPOM,KHPOM,KSREG,KHDIR,KACCEP,KSTRG,KHTRG,KSLOO, | |
33808 | & KHLOO,KSDPO,KHDPO,KEVENT,KSOFT,KHARD | |
33809 | COMMON /PODEBG/ IDEB(NMAXD),KSPOM,KHPOM,KSREG,KHDIR,KACCEP,KSTRG, | |
33810 | & KHTRG,KSLOO,KHLOO,KSDPO,KHDPO,KEVENT,KSOFT,KHARD | |
33811 | C some constants | |
33812 | DOUBLE PRECISION PI,PI2,PI4,GEV2MB,Q_ch,Q_ch2,Q_ch4 | |
33813 | COMMON /POCONS/ PI,PI2,PI4,GEV2MB, | |
33814 | & Q_ch(-6:6),Q_ch2(-6:6),Q_ch4(-6:6) | |
33815 | ||
33816 | S=ECM**2 | |
33817 | PM1 = SIGN(PMASS1**2,PMASS1) | |
33818 | PM2 = SIGN(PMASS2**2,PMASS2) | |
33819 | PP = SQRT(S**2 - 2.D0*PM1*S - 2.D0*PM2*S - 2.D0*PM1*PM2 | |
33820 | & + PM1**2 + PM2**2)/(2.D0*ECM) | |
33821 | ||
33822 | IF(ID.EQ.1) THEN | |
33823 | EE = SQRT( PM1 + PP**2 ) | |
33824 | ELSE IF(ID.EQ.2) THEN | |
33825 | EE = SQRT( PM2 + PP**2 ) | |
33826 | ELSE | |
33827 | WRITE(LO,'(/1X,A,I3,/)') | |
33828 | & 'PHO_PECMS:ERROR: invalid ID number:',ID | |
33829 | EE = PP | |
33830 | ENDIF | |
33831 | ||
33832 | END | |
33833 | ||
33834 | *$ CREATE PHO_FRAINI.FOR | |
33835 | *COPY PHO_FRAINI | |
33836 | CDECK ID>, PHO_FRAINI | |
33837 | SUBROUTINE PHO_FRAINI(IDEFAU) | |
33838 | C*********************************************************************** | |
33839 | C | |
33840 | C initialization of fragmentation packages | |
33841 | C (currently LUND JETSET) | |
33842 | C | |
33843 | C initialization for JETSET call in DTUNUC 1.04 (J.R. 6/93) | |
33844 | C changed to work in PHOJET (R.E. 1/94) | |
33845 | C | |
33846 | C input: IDEFAU 0 no hadronization at all | |
33847 | C 1 do not touch any parameter of JETSET | |
33848 | C 2 default parameters kept, decay length 10mm to | |
33849 | C define stable particles | |
33850 | C 3 load tuned parameters for JETSET 7.3 | |
33851 | C neg. value: prevent strange/charm hadrons from decaying | |
33852 | C | |
33853 | C*********************************************************************** | |
33854 | IMPLICIT DOUBLE PRECISION (A-H,O-Z) | |
33855 | SAVE | |
33856 | ||
33857 | PARAMETER (EPS=1.D-10) | |
33858 | ||
33859 | C input/output channels | |
33860 | INTEGER LI,LO | |
33861 | COMMON /POINOU/ LI,LO | |
33862 | INTEGER N,NPAD,K | |
33863 | DOUBLE PRECISION P,V | |
33864 | COMMON/PYJETS/N,NPAD,K(4000,5),P(4000,5),V(4000,5) | |
33865 | INTEGER MSTU,MSTJ | |
33866 | DOUBLE PRECISION PARU,PARJ | |
33867 | COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) | |
33868 | INTEGER KCHG | |
33869 | DOUBLE PRECISION PMAS,PARF,VCKM | |
33870 | COMMON/PYDAT2/KCHG(500,4),PMAS(500,4),PARF(2000),VCKM(4,4) | |
33871 | INTEGER MDCY,MDME,KFDP | |
33872 | DOUBLE PRECISION BRAT | |
bd378884 | 33873 | COMMON/PYDAT3/MDCY(500,3),MDME(8000,2),BRAT(8000),KFDP(8000,5) |
9aaba0d6 | 33874 | |
33875 | INTEGER PYCOMP | |
33876 | ||
33877 | IDEFAB = ABS(IDEFAU) | |
33878 | ||
33879 | IF(IDEFAB.EQ.0) THEN | |
33880 | WRITE(LO,'(/1X,A)') 'PHO_FRAINI: hadronization switched off' | |
33881 | RETURN | |
33882 | ENDIF | |
33883 | C defaults | |
33884 | DEF2 = PARJ(2) | |
33885 | IDEF12 = MSTJ(12) | |
33886 | DEF19 = PARJ(19) | |
33887 | DEF41 = PARJ(41) | |
33888 | DEF42 = PARJ(42) | |
33889 | DEF21 = PARJ(21) | |
33890 | ||
33891 | C declare stable particles | |
1ddc441c | 33892 | c IF(IDEFAB.GE.2) MSTJ(22) = 2 |
9aaba0d6 | 33893 | |
33894 | C load optimized parameters | |
33895 | IF(IDEFAB.GE.3) THEN | |
33896 | * PARJ(19)=0.19 | |
33897 | C Lund a-parameter | |
33898 | C (default=0.3) | |
33899 | PARJ(41)=0.3 | |
33900 | C Lund b-parameter | |
33901 | C (default=1.0) | |
33902 | PARJ(42)=1.0 | |
33903 | C Lund sigma parameter in pt distribution | |
33904 | C (default=0.36) | |
33905 | PARJ(21)=0.36 | |
33906 | ENDIF | |
33907 | C | |
33908 | C prevent particles decaying | |
33909 | IF(IDEFAU.LT.0) THEN | |
33910 | C K0S | |
33911 | KC=PYCOMP(310) | |
33912 | MDCY(KC,1)=0 | |
33913 | C PI0 | |
33914 | KC=PYCOMP(111) | |
33915 | MDCY(KC,1)=0 | |
33916 | C LAMBDA | |
33917 | KC=PYCOMP(3122) | |
33918 | MDCY(KC,1)=0 | |
33919 | C ALAMBDA | |
33920 | KC=PYCOMP(-3122) | |
33921 | MDCY(KC,1)=0 | |
33922 | C SIG+ | |
33923 | KC=PYCOMP(3222) | |
33924 | MDCY(KC,1)=0 | |
33925 | C ASIG+ | |
33926 | KC=PYCOMP(-3222) | |
33927 | MDCY(KC,1)=0 | |
33928 | C SIG- | |
33929 | KC=PYCOMP(3112) | |
33930 | MDCY(KC,1)=0 | |
33931 | C ASIG- | |
33932 | KC=PYCOMP(-3112) | |
33933 | MDCY(KC,1)=0 | |
33934 | C SIG0 | |
33935 | KC=PYCOMP(3212) | |
33936 | MDCY(KC,1)=0 | |
33937 | C ASIG0 | |
33938 | KC=PYCOMP(-3212) | |
33939 | MDCY(KC,1)=0 | |
33940 | C TET0 | |
33941 | KC=PYCOMP(3322) | |
33942 | MDCY(KC,1)=0 | |
33943 | C ATET0 | |
33944 | KC=PYCOMP(-3322) | |
33945 | MDCY(KC,1)=0 | |
33946 | C TET- | |
33947 | KC=PYCOMP(3312) | |
33948 | MDCY(KC,1)=0 | |
33949 | C ATET- | |
33950 | KC=PYCOMP(-3312) | |
33951 | MDCY(KC,1)=0 | |
33952 | C OMEGA- | |
33953 | KC=PYCOMP(3334) | |
33954 | MDCY(KC,1)=0 | |
33955 | C AOMEGA- | |
33956 | KC=PYCOMP(-3334) | |
33957 | MDCY(KC,1)=0 | |
33958 | C D+ | |
33959 | KC=PYCOMP(411) | |
33960 | MDCY(KC,1)=0 | |
33961 | C D- | |
33962 | KC=PYCOMP(-411) | |
33963 | MDCY(KC,1)=0 | |
33964 | C D0 | |
33965 | KC=PYCOMP(421) | |
33966 | MDCY(KC,1)=0 | |
33967 | C A-D0 | |
33968 | KC=PYCOMP(-421) | |
33969 | MDCY(KC,1)=0 | |
33970 | C DS+ | |
33971 | KC=PYCOMP(431) | |
33972 | MDCY(KC,1)=0 | |
33973 | C A-DS+ | |
33974 | KC=PYCOMP(-431) | |
33975 | MDCY(KC,1)=0 | |
33976 | C ETAC | |
33977 | KC=PYCOMP(441) | |
33978 | MDCY(KC,1)=0 | |
33979 | C LAMBDAC+ | |
33980 | KC=PYCOMP(4122) | |
33981 | MDCY(KC,1)=0 | |
33982 | C A-LAMBDAC+ | |
33983 | KC=PYCOMP(-4122) | |
33984 | MDCY(KC,1)=0 | |
33985 | C SIGMAC++ | |
33986 | KC=PYCOMP(4222) | |
33987 | MDCY(KC,1)=0 | |
33988 | C SIGMAC+ | |
33989 | KC=PYCOMP(4212) | |
33990 | MDCY(KC,1)=0 | |
33991 | C SIGMAC0 | |
33992 | KC=PYCOMP(4112) | |
33993 | MDCY(KC,1)=0 | |
33994 | C A-SIGMAC++ | |
33995 | KC=PYCOMP(-4222) | |
33996 | MDCY(KC,1)=0 | |
33997 | C A-SIGMAC+ | |
33998 | KC=PYCOMP(-4212) | |
33999 | MDCY(KC,1)=0 | |
34000 | C A-SIGMAC0 | |
34001 | KC=PYCOMP(-4112) | |
34002 | MDCY(KC,1)=0 | |
34003 | C KSIC+ | |
34004 | KC=PYCOMP(4232) | |
34005 | MDCY(KC,1)=0 | |
34006 | C KSIC0 | |
34007 | KC=PYCOMP(4132) | |
34008 | MDCY(KC,1)=0 | |
34009 | C A-KSIC+ | |
34010 | KC=PYCOMP(-4232) | |
34011 | MDCY(KC,1)=0 | |
34012 | C A-KSIC0 | |
34013 | KC=PYCOMP(-4132) | |
34014 | MDCY(KC,1)=0 | |
34015 | ENDIF | |
34016 | ||
34017 | WRITE(LO,2355) IDEFAU,DEF2,PARJ(2),IDEF12,MSTJ(12), | |
34018 | & DEF19,PARJ(19),DEF41,PARJ(41),DEF42,PARJ(42),DEF21,PARJ(21) | |
34019 | 2355 FORMAT(/' PHO_FRAINI: fragmentation initialization ISWMDL(6)',I3/, | |
34020 | & ' --------------------------------------------------',/, | |
34021 | & 5X,'parameter description default / current',/, | |
34022 | & 5X,'PARJ( 2) strangeness suppression : ',2F7.3,/, | |
34023 | & 5X,'MSTJ(12) popcorn : ',2I7,/, | |
34024 | & 5X,'PARJ(19) popcorn : ',2F7.3,/, | |
34025 | & 5X,'PARJ(41) Lund a : ',2F7.3,/, | |
34026 | & 5X,'PARJ(42) Lund b : ',2F7.3,/, | |
34027 | & 5X,'PARJ(21) sigma in pt distribution: ',2F7.3,/) | |
34028 | ||
34029 | END | |
34030 | ||
34031 | *$ CREATE PHO_SETPAR.FOR | |
34032 | *COPY PHO_SETPAR | |
34033 | CDECK ID>, PHO_SETPAR | |
34034 | SUBROUTINE pho_setpar(Iside,IDpdg,IDcpc,Pvir) | |
34035 | C********************************************************************** | |
34036 | C | |
34037 | C assign a particle to either side 1 or 2 | |
34038 | C (including special treatment for remnants) | |
34039 | C | |
34040 | C input: Iside 1,2 side selected for the particle | |
34041 | C -2 output of current settings | |
34042 | C IDpdg PDG number | |
34043 | C IDcpc CPC number | |
34044 | C 0 CPC determination in subroutine | |
34045 | C -1 special particle remnant, IDPDG | |
34046 | C is the particle number the remnant | |
34047 | C corresponds to (see /POHDFL/) | |
34048 | C | |
34049 | C********************************************************************** | |
34050 | IMPLICIT NONE | |
34051 | SAVE | |
34052 | ||
34053 | integer Iside,IDpdg,IDcpc | |
34054 | double precision Pvir | |
34055 | ||
34056 | C input/output channels | |
34057 | INTEGER LI,LO | |
34058 | COMMON /POINOU/ LI,LO | |
34059 | C event debugging information | |
34060 | INTEGER NMAXD | |
34061 | PARAMETER (NMAXD=100) | |
34062 | INTEGER IDEB,KSPOM,KHPOM,KSREG,KHDIR,KACCEP,KSTRG,KHTRG,KSLOO, | |
34063 | & KHLOO,KSDPO,KHDPO,KEVENT,KSOFT,KHARD | |
34064 | COMMON /PODEBG/ IDEB(NMAXD),KSPOM,KHPOM,KSREG,KHDIR,KACCEP,KSTRG, | |
34065 | & KHTRG,KSLOO,KHLOO,KSDPO,KHDPO,KEVENT,KSOFT,KHARD | |
34066 | C global event kinematics and particle IDs | |
34067 | INTEGER IFPAP,IFPAB | |
34068 | DOUBLE PRECISION ECM,PCM,PMASS,PVIRT | |
34069 | COMMON /POGCMS/ ECM,PCM,PMASS(2),PVIRT(2),IFPAP(2),IFPAB(2) | |
34070 | C nucleon-nucleus / nucleus-nucleus interface to DPMJET | |
34071 | INTEGER IDEQP,IDEQB,IHFLD,IHFLS | |
34072 | DOUBLE PRECISION ECMN,PCMN,SECM,SPCM,XPSUB,XTSUB | |
34073 | COMMON /POHDFL/ ECMN,PCMN,SECM,SPCM,XPSUB,XTSUB, | |
34074 | & IDEQP(2),IDEQB(2),IHFLD(2,2),IHFLS(2) | |
34075 | C particle ID translation table | |
34076 | integer ID_pdg_list,ID_list,ID_pdg_max | |
34077 | character*12 name_list | |
34078 | COMMON /POPAR1/ ID_pdg_list(300),ID_list(577),name_list(300), | |
34079 | & ID_pdg_max | |
34080 | C general particle data | |
34081 | double precision xm_list,tau_list,gam_list, | |
34082 | & xm_psm2_list,xm_vem2_list,xm_b82_list,xm_b102_list, | |
34083 | & xm_bb82_list,xm_bb102_list | |
34084 | integer ich3_list,iba3_list,iq_list, | |
34085 | & id_psm_list,id_vem_list,id_b8_list,id_b10_list | |
34086 | COMMON /POPAR2/ xm_list(300),tau_list(300),gam_list(300), | |
34087 | & xm_psm2_list(6,6),xm_vem2_list(6,6), | |
34088 | & xm_b82_list(6,6,6),xm_b102_list(6,6,6), | |
34089 | & xm_bb82_list(6,6,6,6),xm_bb102_list(6,6,6,6), | |
34090 | & ich3_list(300),iba3_list(300),iq_list(3,300), | |
34091 | & id_psm_list(6,6),id_vem_list(6,6), | |
34092 | & id_b8_list(6,6,6),id_b10_list(6,6,6) | |
34093 | C particle decay data | |
34094 | double precision wg_sec_list | |
34095 | integer idec_list,isec_list | |
34096 | COMMON /POPAR3/ wg_sec_list(500),idec_list(3,300), | |
34097 | & isec_list(3,500) | |
34098 | ||
34099 | C external functions | |
34100 | integer ipho_pdg2id,ipho_chr3,ipho_bar3 | |
34101 | double precision pho_pmass | |
34102 | ||
34103 | C local variables | |
34104 | integer i,IDcpcN,IDcpcR,IDpdgN,IDpdgR,IDB,IFL1,IFL2,IFL3 | |
34105 | ||
34106 | IF((Iside.EQ.1).OR.(Iside.EQ.2)) THEN | |
34107 | IDcpcN = IDcpc | |
34108 | C remnant? | |
34109 | IF(IDcpc.EQ.-1) THEN | |
34110 | IF(Iside.EQ.1) THEN | |
34111 | IDpdgR = 81 | |
34112 | ELSE | |
34113 | IDpdgR = 82 | |
34114 | ENDIF | |
34115 | IDcpcR = ipho_pdg2id(IDpdgR) | |
34116 | IDEQB(Iside) = ipho_pdg2id(IDpdg) | |
34117 | IDEQP(Iside) = IDpdg | |
34118 | C copy particle properties | |
34119 | IDB = abs(IDEQB(Iside)) | |
34120 | xm_list(IDcpcR) = xm_list(IDB) | |
34121 | tau_list(IDcpcR) = tau_list(IDB) | |
34122 | gam_list(IDcpcR) = gam_list(IDB) | |
34123 | IF(IHFLS(Iside).EQ.1) THEN | |
34124 | ich3_list(IDcpcR) = ipho_chr3(IDEQB(Iside),0) | |
34125 | iba3_list(IDcpcR) = ipho_bar3(IDEQB(Iside),0) | |
34126 | ELSE | |
34127 | ich3_list(IDcpcR) = 0 | |
34128 | iba3_list(IDcpcR) = 0 | |
34129 | ENDIF | |
34130 | C quark content | |
34131 | IFL1 = IHFLD(Iside,1) | |
34132 | IFL2 = IHFLD(Iside,2) | |
34133 | IFL3 = 0 | |
34134 | IF(IHFLS(Iside).EQ.1) THEN | |
34135 | IF(ABS(IHFLD(Iside,1)).GT.1000) THEN | |
34136 | IFL1 = IHFLD(Iside,1)/1000 | |
34137 | IFL2 = MOD(IHFLD(Iside,1)/100,10) | |
34138 | IFL3 = IHFLD(Iside,2) | |
34139 | ELSE IF(ABS(IHFLD(Iside,2)).GT.1000) THEN | |
34140 | IFL1 = IHFLD(Iside,1) | |
34141 | IFL2 = IHFLD(Iside,2)/1000 | |
34142 | IFL3 = MOD(IHFLD(Iside,2)/100,10) | |
34143 | ENDIF | |
34144 | ENDIF | |
34145 | iq_list(1,IDcpcR) = IFL1 | |
34146 | iq_list(2,IDcpcR) = IFL2 | |
34147 | iq_list(3,IDcpcR) = IFL3 | |
34148 | ||
34149 | IDcpcN = IDcpcR | |
34150 | IDPDGN = IDPDGR | |
34151 | ||
34152 | IF(IDEB(87).GE.5) THEN | |
34153 | WRITE(LO,'(1X,A,I2,/5X,A,I7,4I6)') | |
34154 | & 'pho_setpar: remnant assignment side',Iside, | |
34155 | & 'IDPDG,IFL1,2,3,IVAL',IDPDGN,IFL1,IFL2,IFL3,IHFLS(Iside) | |
34156 | ENDIF | |
34157 | ELSE IF(IDcpc.EQ.0) THEN | |
34158 | C ordinary hadron | |
34159 | IHFLS(Iside) = 1 | |
34160 | IHFLD(Iside,1) = 0 | |
34161 | IHFLD(Iside,2) = 0 | |
34162 | IDcpcN = ipho_pdg2id(IDpdg) | |
34163 | IDpdgN = IDpdg | |
34164 | ENDIF | |
34165 | ||
34166 | C initialize /POGCMS/ | |
34167 | IFPAP(Iside) = IDpdgN | |
34168 | IFPAB(Iside) = IDcpcN | |
34169 | PMASS(Iside) = pho_pmass(IDcpcN,0) | |
34170 | IF(IFPAP(Iside).EQ.22) THEN | |
34171 | PVIRT(Iside) = ABS(PVIR) | |
34172 | ELSE | |
34173 | PVIRT(Iside) = 0.D0 | |
34174 | ENDIF | |
34175 | ||
34176 | ELSE IF(Iside.EQ.-2) THEN | |
34177 | C output of current settings | |
34178 | DO 100 I=1,2 | |
34179 | WRITE(LO,'(1X,A,I2,1X,A,I7,I4,1X,1P2E10.3)') | |
34180 | & 'PHO_SETPAR: side', | |
34181 | & I,'IDPDG,IDcpc,PMASS,PVIRT',IFPAP(I),IFPAB(I),PMASS(I), | |
34182 | & PVIRT(I) | |
34183 | IF((IFPAP(I).EQ.81).OR.(IFPAP(I).EQ.82)) THEN | |
34184 | WRITE(LO,'(5X,A,I7,I4,I2,3I5)') | |
34185 | & 'remnant:IDPDG,IDcpc,IVAL,IFLA1,2',IDEQP(I),IDEQB(I), | |
34186 | & IHFLS(I),IHFLD(I,1),IHFLD(I,2) | |
34187 | ENDIF | |
34188 | 100 CONTINUE | |
34189 | ELSE | |
34190 | WRITE(LO,'(/1X,A,I8)') | |
34191 | & 'pho_setpar: invalid argument (Iside)',Iside | |
34192 | ENDIF | |
34193 | ||
34194 | END | |
34195 | ||
34196 | *$ CREATE PHO_XLAM.FOR | |
34197 | *COPY PHO_XLAM | |
34198 | CDECK ID>, PHO_XLAM | |
34199 | DOUBLE PRECISION FUNCTION PHO_XLAM(X,Y,Z) | |
34200 | C********************************************************************** | |
34201 | C | |
34202 | C auxiliary function for two/three particle decay mode | |
34203 | C (standard LAMBDA**(1/2) function) | |
34204 | C | |
34205 | C********************************************************************** | |
34206 | IMPLICIT DOUBLE PRECISION (A-H,O-Z) | |
34207 | SAVE | |
34208 | C | |
34209 | YZ=Y-Z | |
34210 | XLAM=X*X-2.D0*X*(Y+Z)+YZ*YZ | |
34211 | IF(XLAM.LT.0.D0) XLAM=-XLAM | |
34212 | PHO_XLAM=SQRT(XLAM) | |
34213 | END | |
34214 | ||
34215 | *$ CREATE PHO_BESSJ0.FOR | |
34216 | *COPY PHO_BESSJ0 | |
34217 | CDECK ID>, PHO_BESSJ0 | |
34218 | DOUBLE PRECISION FUNCTION PHO_BESSJ0(DX) | |
34219 | C********************************************************************** | |
34220 | C | |
34221 | C CERN (KERN) LIB function C312 | |
34222 | C | |
34223 | C modified by R. Engel (03/02/93) | |
34224 | C | |
34225 | C********************************************************************** | |
34226 | DOUBLE PRECISION DX | |
34227 | DOUBLE PRECISION X,Y,V,H,ALFA,EIGHT | |
34228 | DOUBLE PRECISION PI1,PI2,C1(0:14),C2(0:9),C3(0:10),B0,B1,B2,P,Q,R | |
34229 | SAVE | |
34230 | ||
34231 | DATA EIGHT /8.0D0/ | |
34232 | DATA PI1 /0.79788 45608 0287D0/, PI2 /0.78539 81633 9745D0/ | |
34233 | ||
34234 | DATA C1( 0) /+0.15772 79714 7489D0/ | |
34235 | DATA C1( 1) /-0.00872 34423 5285D0/ | |
34236 | DATA C1( 2) /+0.26517 86132 0334D0/ | |
34237 | DATA C1( 3) /-0.37009 49938 7265D0/ | |
34238 | DATA C1( 4) /+0.15806 71023 3210D0/ | |
34239 | DATA C1( 5) /-0.03489 37694 1141D0/ | |
34240 | DATA C1( 6) /+0.00481 91800 6947D0/ | |
34241 | DATA C1( 7) /-0.00046 06261 6621D0/ | |
34242 | DATA C1( 8) /+0.00003 24603 2882D0/ | |
34243 | DATA C1( 9) /-0.00000 17619 4691D0/ | |
34244 | DATA C1(10) /+0.00000 00760 8164D0/ | |
34245 | DATA C1(11) /-0.00000 00026 7925D0/ | |
34246 | DATA C1(12) /+0.00000 00000 7849D0/ | |
34247 | DATA C1(13) /-0.00000 00000 0194D0/ | |
34248 | DATA C1(14) /+0.00000 00000 0004D0/ | |
34249 | ||
34250 | DATA C2( 0) /+0.99946 03493 4752D0/ | |
34251 | DATA C2( 1) /-0.00053 65220 4681D0/ | |
34252 | DATA C2( 2) /+0.00000 30751 8479D0/ | |
34253 | DATA C2( 3) /-0.00000 00517 0595D0/ | |
34254 | DATA C2( 4) /+0.00000 00016 3065D0/ | |
34255 | DATA C2( 5) /-0.00000 00000 7864D0/ | |
34256 | DATA C2( 6) /+0.00000 00000 0517D0/ | |
34257 | DATA C2( 7) /-0.00000 00000 0043D0/ | |
34258 | DATA C2( 8) /+0.00000 00000 0004D0/ | |
34259 | DATA C2( 9) /-0.00000 00000 0001D0/ | |
34260 | ||
34261 | DATA C3( 0) /-0.01555 58546 05337D0/ | |
34262 | DATA C3( 1) /+0.00006 83851 99426D0/ | |
34263 | DATA C3( 2) /-0.00000 07414 49841D0/ | |
34264 | DATA C3( 3) /+0.00000 00179 72457D0/ | |
34265 | DATA C3( 4) /-0.00000 00007 27192D0/ | |
34266 | DATA C3( 5) /+0.00000 00000 42201D0/ | |
34267 | DATA C3( 6) /-0.00000 00000 03207D0/ | |
34268 | DATA C3( 7) /+0.00000 00000 00301D0/ | |
34269 | DATA C3( 8) /-0.00000 00000 00033D0/ | |
34270 | DATA C3( 9) /+0.00000 00000 00004D0/ | |
34271 | DATA C3(10) /-0.00000 00000 00001D0/ | |
34272 | ||
34273 | X=DX | |
34274 | V=ABS(X) | |
34275 | IF(V .LT. EIGHT) THEN | |
34276 | Y=V/EIGHT | |
34277 | H=2.D0*Y**2-1.D0 | |
34278 | ALFA=-2.D0*H | |
34279 | B1=0.D0 | |
34280 | B2=0.D0 | |
34281 | DO 1 I = 14,0,-1 | |
34282 | B0=C1(I)-ALFA*B1-B2 | |
34283 | B2=B1 | |
34284 | 1 B1=B0 | |
34285 | B1=B0-H*B2 | |
34286 | ELSE | |
34287 | R=1.D0/V | |
34288 | Y=EIGHT*R | |
34289 | H=2.D0*Y**2-1.D0 | |
34290 | ALFA=-2.D0*H | |
34291 | B1=0.D0 | |
34292 | B2=0.D0 | |
34293 | DO 2 I = 9,0,-1 | |
34294 | B0=C2(I)-ALFA*B1-B2 | |
34295 | B2=B1 | |
34296 | 2 B1=B0 | |
34297 | P=B0-H*B2 | |
34298 | B1=0.D0 | |
34299 | B2=0.D0 | |
34300 | DO 3 I = 10,0,-1 | |
34301 | B0=C3(I)-ALFA*B1-B2 | |
34302 | B2=B1 | |
34303 | 3 B1=B0 | |
34304 | Q=Y*(B0-H*B2) | |
34305 | B0=V-PI2 | |
34306 | B1=PI1*SQRT(R)*(P*COS(B0)-Q*SIN(B0)) | |
34307 | ENDIF | |
34308 | PHO_BESSJ0=B1 | |
34309 | RETURN | |
34310 | END | |
34311 | ||
34312 | *$ CREATE PHO_BESSI0.FOR | |
34313 | *COPY PHO_BESSI0 | |
34314 | CDECK ID>, PHO_BESSI0 | |
34315 | DOUBLE PRECISION FUNCTION PHO_BESSI0(X) | |
34316 | C********************************************************************** | |
34317 | C | |
34318 | C Bessel Function I0 | |
34319 | C | |
34320 | C********************************************************************** | |
34321 | IMPLICIT DOUBLE PRECISION (A-H,O-Z) | |
34322 | SAVE | |
34323 | ||
34324 | AX = ABS(X) | |
34325 | IF (AX .LT. 3.75D0) THEN | |
34326 | Y = (X/3.75D0)**2 | |
34327 | PHO_BESSI0 = | |
34328 | & 1.0D0+Y*(3.5156229D0+Y*(3.0899424D0+Y*(1.2067492D0 | |
34329 | & +Y*(0.2659732D0+Y*(0.360768D-1+Y*0.45813D-2))))) | |
34330 | ELSE | |
34331 | Y = 3.75D0/AX | |
34332 | PHO_BESSI0 = | |
34333 | & (EXP(AX)/SQRT(AX))*(0.39894228D0+Y*(0.1328592D-1 | |
34334 | & +Y*(0.225319D-2+Y*(-0.157565D-2+Y*(0.916281D-2 | |
34335 | & +Y*(-0.2057706D-1+Y*(0.2635537D-1+Y*(-0.1647633D-1 | |
34336 | & +Y*0.392377D-2)))))))) | |
34337 | ENDIF | |
34338 | ||
34339 | END | |
34340 | ||
34341 | *$ CREATE PHO_BESSI1.FOR | |
34342 | *COPY PHO_BESSI1 | |
34343 | CDECK ID>, PHO_BESSI1 | |
34344 | DOUBLE PRECISION FUNCTION PHO_BESSI1(X) | |
34345 | C********************************************************************** | |
34346 | C | |
34347 | C Bessel Function I1 | |
34348 | C | |
34349 | C********************************************************************** | |
34350 | IMPLICIT DOUBLE PRECISION (A-H,O-Z) | |
34351 | SAVE | |
34352 | ||
34353 | AX = ABS(X) | |
34354 | ||
34355 | IF (AX .LT. 3.75D0) THEN | |
34356 | Y = (X/3.75D0)**2 | |
34357 | BESLI1 = | |
34358 | & AX*(0.5D0+Y*(0.87890594D0+Y*(0.51498869D0+Y*(0.15084934D0 | |
34359 | & +Y*(0.2658733D-1+Y*(0.301532D-2+Y*0.32411D-3)))))) | |
34360 | ELSE | |
34361 | Y = 3.75D0/AX | |
34362 | BESLI1 = | |
34363 | & 0.2282967D-1+Y*(-0.2895312D-1+Y*(0.1787654D-1 | |
34364 | & -Y*0.420059D-2)) | |
34365 | BESLI1 = | |
34366 | & 0.39894228D0+Y*(-0.3988024D-1+Y*(-0.362018D-2 | |
34367 | & +Y*(0.163801D-2+Y*(-0.1031555D-1+Y*BESLI1)))) | |
34368 | BESLI1 = BESLI1 * EXP(AX)/SQRT(AX) | |
34369 | ENDIF | |
34370 | IF (X .LT. 0.D0) BESLI1 = -BESLI1 | |
34371 | ||
34372 | PHO_BESSI1 = BESLI1 | |
34373 | ||
34374 | END | |
34375 | ||
34376 | *$ CREATE PHO_BESSK0.FOR | |
34377 | *COPY PHO_BESSK0 | |
34378 | CDECK ID>, PHO_BESSK0 | |
34379 | DOUBLE PRECISION FUNCTION PHO_BESSK0(X) | |
34380 | C********************************************************************** | |
34381 | C | |
34382 | C Modified Bessel Function K0 | |
34383 | C | |
34384 | C********************************************************************** | |
34385 | IMPLICIT DOUBLE PRECISION (A-H,O-Z) | |
34386 | SAVE | |
34387 | ||
34388 | IF (X .LT. 2.D0) THEN | |
34389 | Y = X**2/4.D0 | |
34390 | PHO_BESSK0 = | |
34391 | & (-LOG(X/2.D0)*PHO_BESSI0(X))+(-.57721566D0+Y*(0.42278420D0 | |
34392 | & +Y*(0.23069756D0+Y*(0.3488590D-1+Y*(0.262698D-2 | |
34393 | & +Y*(0.10750D-3+Y*0.740D-5)))))) | |
34394 | ELSE | |
34395 | Y = 2.D0/X | |
34396 | PHO_BESSK0 = | |
34397 | & (EXP(-X)/SQRT(X))*(1.25331414D0+Y*(-0.7832358D-1 | |
34398 | & +Y*(0.2189568D-1+Y*(-0.1062446D-1+Y*(0.587872D-2 | |
34399 | & +Y*(-0.251540D-2+Y*0.53208D-3)))))) | |
34400 | ENDIF | |
34401 | ||
34402 | END | |
34403 | ||
34404 | *$ CREATE PHO_BESSK1.FOR | |
34405 | *COPY PHO_BESSK1 | |
34406 | CDECK ID>, PHO_BESSK1 | |
34407 | DOUBLE PRECISION FUNCTION PHO_BESSK1(X) | |
34408 | C********************************************************************** | |
34409 | C | |
34410 | C Modified Bessel Function K1 | |
34411 | C | |
34412 | C********************************************************************** | |
34413 | IMPLICIT DOUBLE PRECISION (A-H,O-Z) | |
34414 | SAVE | |
34415 | ||
34416 | IF (X .LT. 2.D0) THEN | |
34417 | Y = X**2/4.D0 | |
34418 | PHO_BESSK1 = | |
34419 | & (LOG(X/2.D0)*PHO_BESSI1(X))+(1.D0/X)*(1.D0+Y*(0.15443144D0 | |
34420 | & +Y*(-0.67278579D0+Y*(-0.18156897D0+Y*(-0.1919402D-1 | |
34421 | & +Y*(-0.110404D-2+Y*(-0.4686D-4))))))) | |
34422 | ELSE | |
34423 | Y=2.D0/X | |
34424 | PHO_BESSK1 = | |
34425 | & (EXP(-X)/SQRT(X))*(1.25331414D0+Y*(0.23498619D0 | |
34426 | & +Y*(-0.3655620D-1+Y*(0.1504268D-1+Y*(-0.780353D-2 | |
34427 | & +Y*(0.325614D-2+Y*(-0.68245D-3))))))) | |
34428 | ENDIF | |
34429 | ||
34430 | END | |
34431 | ||
34432 | *$ CREATE PHO_GAUSET.FOR | |
34433 | *COPY PHO_GAUSET | |
34434 | CDECK ID>, PHO_GAUSET | |
34435 | SUBROUTINE PHO_GAUSET(AX,BX,NX,Z,W) | |
34436 | C******************************************************************** | |
34437 | C | |
34438 | C N-point gauss zeros and weights for the interval (AX,BX) are | |
34439 | C stored in arrays Z and W respectively. | |
34440 | C | |
34441 | C********************************************************************* | |
34442 | IMPLICIT DOUBLE PRECISION (A-H,O-Z) | |
34443 | SAVE | |
34444 | ||
34445 | COMMON /POGDAT/A(273),X(273),KTAB(96) | |
34446 | DIMENSION Z(NX),W(NX) | |
34447 | ||
34448 | ALPHA=0.5*(BX+AX) | |
34449 | BETA=0.5*(BX-AX) | |
34450 | N=NX | |
34451 | ||
34452 | C the N=1 case: | |
34453 | IF(N.NE.1) GO TO 1 | |
34454 | Z(1)=ALPHA | |
34455 | W(1)=BX-AX | |
34456 | RETURN | |
34457 | ||
34458 | C the Gauss cases: | |
34459 | 1 IF((N.LE.16).AND.(N.GT.1)) GO TO 2 | |
34460 | IF(N.EQ.20) GO TO 2 | |
34461 | IF(N.EQ.24) GO TO 2 | |
34462 | IF(N.EQ.32) GO TO 2 | |
34463 | IF(N.EQ.40) GO TO 2 | |
34464 | IF(N.EQ.48) GO TO 2 | |
34465 | IF(N.EQ.64) GO TO 2 | |
34466 | IF(N.EQ.80) GO TO 2 | |
34467 | IF(N.EQ.96) GO TO 2 | |
34468 | ||
34469 | C the extended Gauss cases: | |
34470 | IF((N/96)*96.EQ.N) GO TO 3 | |
34471 | ||
34472 | C jump to center of intervall intrgration: | |
34473 | GO TO 100 | |
34474 | ||
34475 | C get Gauss point array | |
34476 | ||
34477 | 2 CALL PHO_GAUDAT | |
34478 | C extract real points | |
34479 | K=KTAB(N) | |
34480 | M=N/2 | |
34481 | DO 21 J=1,M | |
34482 | C extract values from big array | |
34483 | JTAB=K-1+J | |
34484 | WTEMP=BETA*A(JTAB) | |
34485 | DELTA=BETA*X(JTAB) | |
34486 | C store them backward | |
34487 | Z(J)=ALPHA-DELTA | |
34488 | W(J)=WTEMP | |
34489 | C store them forward | |
34490 | JP=N+1-J | |
34491 | Z(JP)=ALPHA+DELTA | |
34492 | W(JP)=WTEMP | |
34493 | 21 CONTINUE | |
34494 | C store central point (odd N) | |
34495 | IF((N-M-M).EQ.0) RETURN | |
34496 | Z(M+1)=ALPHA | |
34497 | JMID=K+M | |
34498 | W(M+1)=BETA*A(JMID) | |
34499 | RETURN | |
34500 | ||
34501 | C get ND96 times chained 96 Gauss point array | |
34502 | ||
34503 | 3 CALL PHO_GAUDAT | |
34504 | C print out message | |
34505 | C -extract real points | |
34506 | K=KTAB(96) | |
34507 | ND96=N/96 | |
34508 | DO 31 J=1,48 | |
34509 | C extract values from big array | |
34510 | JTAB=K-1+J | |
34511 | WTEMP=BETA*A(JTAB) | |
34512 | DELTA=BETA*X(JTAB) | |
34513 | WTeMP=WTEMP/ND96 | |
34514 | DeLTA=DELTA/ND96 | |
34515 | DO 32 JD96=0,ND96-1 | |
34516 | ZCNTR= (ALPHA-BETA)+ BETA*FLOAT(2*JD96+1)/FLOAT(ND96) | |
34517 | C store them backward | |
34518 | Z(J+JD96*96)=ZCNTR-DELTA | |
34519 | W(J+JD96*96)=WTEMP | |
34520 | C store them forward | |
34521 | JP=96+1-J | |
34522 | Z(JP+JD96*96)=ZCNTR+DELTA | |
34523 | W(JP+JD96*96)=WTEMP | |
34524 | 32 CONTINUE | |
34525 | 31 CONTINUE | |
34526 | RETURN | |
34527 | ||
34528 | C the center of intervall cases: | |
34529 | 100 CONTINUE | |
34530 | C put in constant weight and equally spaced central points | |
34531 | N=IABS(N) | |
34532 | DO 111 IN=1,N | |
34533 | WIN=(BX-AX)/FLOAT(N) | |
34534 | Z(IN)=AX + (FLOAT(IN)-.5)*WIN | |
34535 | 111 W(IN)=WIN | |
34536 | ||
34537 | END | |
34538 | ||
34539 | *$ CREATE PHO_GAUDAT.FOR | |
34540 | *COPY PHO_GAUDAT | |
34541 | CDECK ID>, PHO_GAUDAT | |
34542 | SUBROUTINE PHO_GAUDAT | |
34543 | C********************************************************************* | |
34544 | C | |
34545 | C store big arrays needed for Gauss integral, CERNLIB D106BD | |
34546 | C (arrays A,X,ITAB copied on B,Y,LTAB) | |
34547 | C | |
34548 | C********************************************************************* | |
34549 | IMPLICIT DOUBLE PRECISION (A-H,O-Z) | |
34550 | ||
34551 | SAVE | |
34552 | COMMON /POGDAT/ B(273),Y(273),LTAB(96) | |
34553 | DIMENSION A(273),X(273),KTAB(96) | |
34554 | ||
34555 | C-----TABLE OF INITIAL SUBSCRIPTS FOR N=2(1)16(4)96 | |
34556 | DATA KTAB(2)/1/ | |
34557 | DATA KTAB(3)/2/ | |
34558 | DATA KTAB(4)/4/ | |
34559 | DATA KTAB(5)/6/ | |
34560 | DATA KTAB(6)/9/ | |
34561 | DATA KTAB(7)/12/ | |
34562 | DATA KTAB(8)/16/ | |
34563 | DATA KTAB(9)/20/ | |
34564 | DATA KTAB(10)/25/ | |
34565 | DATA KTAB(11)/30/ | |
34566 | DATA KTAB(12)/36/ | |
34567 | DATA KTAB(13)/42/ | |
34568 | DATA KTAB(14)/49/ | |
34569 | DATA KTAB(15)/56/ | |
34570 | DATA KTAB(16)/64/ | |
34571 | DATA KTAB(20)/72/ | |
34572 | DATA KTAB(24)/82/ | |
34573 | DATA KTAB(28)/82/ | |
34574 | DATA KTAB(32)/94/ | |
34575 | DATA KTAB(36)/94/ | |
34576 | DATA KTAB(40)/110/ | |
34577 | DATA KTAB(44)/110/ | |
34578 | DATA KTAB(48)/130/ | |
34579 | DATA KTAB(52)/130/ | |
34580 | DATA KTAB(56)/130/ | |
34581 | DATA KTAB(60)/130/ | |
34582 | DATA KTAB(64)/154/ | |
34583 | DATA KTAB(68)/154/ | |
34584 | DATA KTAB(72)/154/ | |
34585 | DATA KTAB(76)/154/ | |
34586 | DATA KTAB(80)/186/ | |
34587 | DATA KTAB(84)/186/ | |
34588 | DATA KTAB(88)/186/ | |
34589 | DATA KTAB(92)/186/ | |
34590 | DATA KTAB(96)/226/ | |
34591 | C | |
34592 | C-----TABLE OF ABSCISSAE (X) AND WEIGHTS (A) FOR INTERVAL (-1,+1). | |
34593 | C | |
34594 | C-----N=2 | |
34595 | DATA X(1)/0.577350269189626D0 /, A(1)/1.000000000000000D0 / | |
34596 | C-----N=3 | |
34597 | DATA X(2)/0.774596669241483D0 /, A(2)/0.555555555555556D0 / | |
34598 | DATA X(3)/0.000000000000000D0 /, A(3)/0.888888888888889D0 / | |
34599 | C-----N=4 | |
34600 | DATA X(4)/0.861136311594053D0 /, A(4)/0.347854845137454D0 / | |
34601 | DATA X(5)/0.339981043584856D0 /, A(5)/0.652145154862546D0 / | |
34602 | C-----N=5 | |
34603 | DATA X(6)/0.906179845938664D0 /, A(6)/0.236926885056189D0 / | |
34604 | DATA X(7)/0.538469310105683D0 /, A(7)/0.478628670499366D0 / | |
34605 | DATA X(8)/0.000000000000000D0 /, A(8)/0.568888888888889D0 / | |
34606 | C-----N=6 | |
34607 | DATA X(9)/0.932469514203152D0 /, A(9)/0.171324492379170D0 / | |
34608 | DATA X(10)/0.661209386466265D0 /, A(10)/0.360761573048139D0 / | |
34609 | DATA X(11)/0.238619186083197D0 /, A(11)/0.467913934572691D0 / | |
34610 | C-----N=7 | |
34611 | DATA X(12)/0.949107912342759D0 /, A(12)/0.129484966168870D0 / | |
34612 | DATA X(13)/0.741531185599394D0 /, A(13)/0.279705391489277D0 / | |
34613 | DATA X(14)/0.405845151377397D0 /, A(14)/0.381830050505119D0 / | |
34614 | DATA X(15)/0.000000000000000D0 /, A(15)/0.417959183673469D0 / | |
34615 | C-----N=8 | |
34616 | DATA X(16)/0.960289856497536D0 /, A(16)/0.101228536290376D0 / | |
34617 | DATA X(17)/0.796666477413627D0 /, A(17)/0.222381034453374D0 / | |
34618 | DATA X(18)/0.525532409916329D0 /, A(18)/0.313706645877887D0 / | |
34619 | DATA X(19)/0.183434642495650D0 /, A(19)/0.362683783378362D0 / | |
34620 | C-----N=9 | |
34621 | DATA X(20)/0.968160239507626D0 /, A(20)/0.081274388361574D0 / | |
34622 | DATA X(21)/0.836031107326636D0 /, A(21)/0.180648160694857D0 / | |
34623 | DATA X(22)/0.613371432700590D0 /, A(22)/0.260610696402935D0 / | |
34624 | DATA X(23)/0.324253423403809D0 /, A(23)/0.312347077040003D0 / | |
34625 | DATA X(24)/0.000000000000000D0 /, A(24)/0.330239355001260D0 / | |
34626 | C-----N=10 | |
34627 | DATA X(25)/0.973906528517172D0 /, A(25)/0.066671344308688D0 / | |
34628 | DATA X(26)/0.865063366688985D0 /, A(26)/0.149451349150581D0 / | |
34629 | DATA X(27)/0.679409568299024D0 /, A(27)/0.219086362515982D0 / | |
34630 | DATA X(28)/0.433395394129247D0 /, A(28)/0.269266719309996D0 / | |
34631 | DATA X(29)/0.148874338981631D0 /, A(29)/0.295524224714753D0 / | |
34632 | C-----N=11 | |
34633 | DATA X(30)/0.978228658146057D0 /, A(30)/0.055668567116174D0 / | |
34634 | DATA X(31)/0.887062599768095D0 /, A(31)/0.125580369464905D0 / | |
34635 | DATA X(32)/0.730152005574049D0 /, A(32)/0.186290210927734D0 / | |
34636 | DATA X(33)/0.519096129206812D0 /, A(33)/0.233193764591990D0 / | |
34637 | DATA X(34)/0.269543155952345D0 /, A(34)/0.262804544510247D0 / | |
34638 | DATA X(35)/0.000000000000000D0 /, A(35)/0.272925086777901D0 / | |
34639 | C-----N=12 | |
34640 | DATA X(36)/0.981560634246719D0 /, A(36)/0.047175336386512D0 / | |
34641 | DATA X(37)/0.904117256370475D0 /, A(37)/0.106939325995318D0 / | |
34642 | DATA X(38)/0.769902674194305D0 /, A(38)/0.160078328543346D0 / | |
34643 | DATA X(39)/0.587317954286617D0 /, A(39)/0.203167426723066D0 / | |
34644 | DATA X(40)/0.367831498998180D0 /, A(40)/0.233492536538355D0 / | |
34645 | DATA X(41)/0.125233408511469D0 /, A(41)/0.249147045813403D0 / | |
34646 | C-----N=13 | |
34647 | DATA X(42)/0.984183054718588D0 /, A(42)/0.040484004765316D0 / | |
34648 | DATA X(43)/0.917598399222978D0 /, A(43)/0.092121499837728D0 / | |
34649 | DATA X(44)/0.801578090733310D0 /, A(44)/0.138873510219787D0 / | |
34650 | DATA X(45)/0.642349339440340D0 /, A(45)/0.178145980761946D0 / | |
34651 | DATA X(46)/0.448492751036447D0 /, A(46)/0.207816047536889D0 / | |
34652 | DATA X(47)/0.230458315955135D0 /, A(47)/0.226283180262897D0 / | |
34653 | DATA X(48)/0.000000000000000D0 /, A(48)/0.232551553230874D0 / | |
34654 | C-----N=14 | |
34655 | DATA X(49)/0.986283808696812D0 /, A(49)/0.035119460331752D0 / | |
34656 | DATA X(50)/0.928434883663574D0 /, A(50)/0.080158087159760D0 / | |
34657 | DATA X(51)/0.827201315069765D0 /, A(51)/0.121518570687903D0 / | |
34658 | DATA X(52)/0.687292904811685D0 /, A(52)/0.157203167158194D0 / | |
34659 | DATA X(53)/0.515248636358154D0 /, A(53)/0.185538397477938D0 / | |
34660 | DATA X(54)/0.319112368927890D0 /, A(54)/0.205198463721296D0 / | |
34661 | DATA X(55)/0.108054948707344D0 /, A(55)/0.215263853463158D0 / | |
34662 | C-----N=15 | |
34663 | DATA X(56)/0.987992518020485D0 /, A(56)/0.030753241996117D0 / | |
34664 | DATA X(57)/0.937273392400706D0 /, A(57)/0.070366047488108D0 / | |
34665 | DATA X(58)/0.848206583410427D0 /, A(58)/0.107159220467172D0 / | |
34666 | DATA X(59)/0.724417731360170D0 /, A(59)/0.139570677926154D0 / | |
34667 | DATA X(60)/0.570972172608539D0 /, A(60)/0.166269205816994D0 / | |
34668 | DATA X(61)/0.394151347077563D0 /, A(61)/0.186161000015562D0 / | |
34669 | DATA X(62)/0.201194093997435D0 /, A(62)/0.198431485327111D0 / | |
34670 | DATA X(63)/0.000000000000000D0 /, A(63)/0.202578241925561D0 / | |
34671 | C-----N=16 | |
34672 | DATA X(64)/0.989400934991650D0 /, A(64)/0.027152459411754D0 / | |
34673 | DATA X(65)/0.944575023073233D0 /, A(65)/0.062253523938648D0 / | |
34674 | DATA X(66)/0.865631202387832D0 /, A(66)/0.095158511682493D0 / | |
34675 | DATA X(67)/0.755404408355003D0 /, A(67)/0.124628971255534D0 / | |
34676 | DATA X(68)/0.617876244402644D0 /, A(68)/0.149595988816577D0 / | |
34677 | DATA X(69)/0.458016777657227D0 /, A(69)/0.169156519395003D0 / | |
34678 | DATA X(70)/0.281603550779259D0 /, A(70)/0.182603415044924D0 / | |
34679 | DATA X(71)/0.095012509837637D0 /, A(71)/0.189450610455069D0 / | |
34680 | C-----N=20 | |
34681 | DATA X(72)/0.993128599185094D0 /, A(72)/0.017614007139152D0 / | |
34682 | DATA X(73)/0.963971927277913D0 /, A(73)/0.040601429800386D0 / | |
34683 | DATA X(74)/0.912234428251325D0 /, A(74)/0.062672048334109D0 / | |
34684 | DATA X(75)/0.839116971822218D0 /, A(75)/0.083276741576704D0 / | |
34685 | DATA X(76)/0.746331906460150D0 /, A(76)/0.101930119817240D0 / | |
34686 | DATA X(77)/0.636053680726515D0 /, A(77)/0.118194531961518D0 / | |
34687 | DATA X(78)/0.510867001950827D0 /, A(78)/0.131688638449176D0 / | |
34688 | DATA X(79)/0.373706088715419D0 /, A(79)/0.142096109318382D0 / | |
34689 | DATA X(80)/0.227785851141645D0 /, A(80)/0.149172986472603D0 / | |
34690 | DATA X(81)/0.076526521133497D0 /, A(81)/0.152753387130725D0 / | |
34691 | C-----N=24 | |
34692 | DATA X(82)/0.995187219997021D0 /, A(82)/0.012341229799987D0 / | |
34693 | DATA X(83)/0.974728555971309D0 /, A(83)/0.028531388628933D0 / | |
34694 | DATA X(84)/0.938274552002732D0 /, A(84)/0.044277438817419D0 / | |
34695 | DATA X(85)/0.886415527004401D0 /, A(85)/0.059298584915436D0 / | |
34696 | DATA X(86)/0.820001985973902D0 /, A(86)/0.073346481411080D0 / | |
34697 | DATA X(87)/0.740124191578554D0 /, A(87)/0.086190161531953D0 / | |
34698 | DATA X(88)/0.648093651936975D0 /, A(88)/0.097618652104113D0 / | |
34699 | DATA X(89)/0.545421471388839D0 /, A(89)/0.107444270115965D0 / | |
34700 | DATA X(90)/0.433793507626045D0 /, A(90)/0.115505668053725D0 / | |
34701 | DATA X(91)/0.315042679696163D0 /, A(91)/0.121670472927803D0 / | |
34702 | DATA X(92)/0.191118867473616D0 /, A(92)/0.125837456346828D0 / | |
34703 | DATA X(93)/0.064056892862605D0 /, A(93)/0.127938195346752D0 / | |
34704 | C-----N=32 | |
34705 | DATA X(94)/0.997263861849481D0 /, A(94)/0.007018610009470D0 / | |
34706 | DATA X(95)/0.985611511545268D0 /, A(95)/0.016274394730905D0 / | |
34707 | DATA X(96)/0.964762255587506D0 /, A(96)/0.025392065309262D0 / | |
34708 | DATA X(97)/0.934906075937739D0 /, A(97)/0.034273862913021D0 / | |
34709 | DATA X(98)/0.896321155766052D0 /, A(98)/0.042835898022226D0 / | |
34710 | DATA X(99)/0.849367613732569D0 /, A(99)/0.050998059262376D0 / | |
34711 | DATA X(100)/0.794483795967942D0/, A(100)/0.058684093478535D0/ | |
34712 | DATA X(101)/0.732182118740289D0/, A(101)/0.065822222776361D0/ | |
34713 | DATA X(102)/0.663044266930215D0/, A(102)/0.072345794108848D0/ | |
34714 | DATA X(103)/0.587715757240762D0/, A(103)/0.078193895787070D0/ | |
34715 | DATA X(104)/0.506899908932229D0/, A(104)/0.083311924226946D0/ | |
34716 | DATA X(105)/0.421351276130635D0/, A(105)/0.087652093004403D0/ | |
34717 | DATA X(106)/0.331868602282127D0/, A(106)/0.091173878695763D0/ | |
34718 | DATA X(107)/0.239287362252137D0/, A(107)/0.093844399080804D0/ | |
34719 | DATA X(108)/0.144471961582796D0/, A(108)/0.095638720079274D0/ | |
34720 | DATA X(109)/0.048307665687738D0/, A(109)/0.096540088514727D0/ | |
34721 | C-----N=40 | |
34722 | DATA X(110)/0.998237709710559D0/, A(110)/0.004521277098533D0/ | |
34723 | DATA X(111)/0.990726238699457D0/, A(111)/0.010498284531152D0/ | |
34724 | DATA X(112)/0.977259949983774D0/, A(112)/0.016421058381907D0/ | |
34725 | DATA X(113)/0.957916819213791D0/, A(113)/0.022245849194166D0/ | |
34726 | DATA X(114)/0.932812808278676D0/, A(114)/0.027937006980023D0/ | |
34727 | DATA X(115)/0.902098806968874D0/, A(115)/0.033460195282547D0/ | |
34728 | DATA X(116)/0.865959503212259D0/, A(116)/0.038782167974472D0/ | |
34729 | DATA X(117)/0.824612230833311D0/, A(117)/0.043870908185673D0/ | |
34730 | DATA X(118)/0.778305651426519D0/, A(118)/0.048695807635072D0/ | |
34731 | DATA X(119)/0.727318255189927D0/, A(119)/0.053227846983936D0/ | |
34732 | DATA X(120)/0.671956684614179D0/, A(120)/0.057439769099391D0/ | |
34733 | DATA X(121)/0.612553889667980D0/, A(121)/0.061306242492928D0/ | |
34734 | DATA X(122)/0.549467125095128D0/, A(122)/0.064804013456601D0/ | |
34735 | DATA X(123)/0.483075801686178D0/, A(123)/0.067912045815233D0/ | |
34736 | DATA X(124)/0.413779204371605D0/, A(124)/0.070611647391286D0/ | |
34737 | DATA X(125)/0.341994090825758D0/, A(125)/0.072886582395804D0/ | |
34738 | DATA X(126)/0.268152185007253D0/, A(126)/0.074723169057968D0/ | |
34739 | DATA X(127)/0.192697580701371D0/, A(127)/0.076110361900626D0/ | |
34740 | DATA X(128)/0.116084070675255D0/, A(128)/0.077039818164247D0/ | |
34741 | DATA X(129)/0.038772417506050D0/, A(129)/0.077505947978424D0/ | |
34742 | C-----N=48 | |
34743 | DATA X(130)/0.998771007252426D0/, A(130)/0.003153346052305D0/ | |
34744 | DATA X(131)/0.993530172266350D0/, A(131)/0.007327553901276D0/ | |
34745 | DATA X(132)/0.984124583722826D0/, A(132)/0.011477234579234D0/ | |
34746 | DATA X(133)/0.970591592546247D0/, A(133)/0.015579315722943D0/ | |
34747 | DATA X(134)/0.952987703160430D0/, A(134)/0.019616160457355D0/ | |
34748 | DATA X(135)/0.931386690706554D0/, A(135)/0.023570760839324D0/ | |
34749 | DATA X(136)/0.905879136715569D0/, A(136)/0.027426509708356D0/ | |
34750 | DATA X(137)/0.876572020274247D0/, A(137)/0.031167227832798D0/ | |
34751 | DATA X(138)/0.843588261624393D0/, A(138)/0.034777222564770D0/ | |
34752 | DATA X(139)/0.807066204029442D0/, A(139)/0.038241351065830D0/ | |
34753 | DATA X(140)/0.767159032515740D0/, A(140)/0.041545082943464D0/ | |
34754 | DATA X(141)/0.724034130923814D0/, A(141)/0.044674560856694D0/ | |
34755 | DATA X(142)/0.677872379632663D0/, A(142)/0.047616658492490D0/ | |
34756 | DATA X(143)/0.628867396776513D0/, A(143)/0.050359035553854D0/ | |
34757 | DATA X(144)/0.577224726083972D0/, A(144)/0.052890189485193D0/ | |
34758 | DATA X(145)/0.523160974722233D0/, A(145)/0.055199503699984D0/ | |
34759 | DATA X(146)/0.466902904750958D0/, A(146)/0.057277292100403D0/ | |
34760 | DATA X(147)/0.408686481990716D0/, A(147)/0.059114839698395D0/ | |
34761 | DATA X(148)/0.348755886292160D0/, A(148)/0.060704439165893D0/ | |
34762 | DATA X(149)/0.287362487355455D0/, A(149)/0.062039423159892D0/ | |
34763 | DATA X(150)/0.224763790394689D0/, A(150)/0.063114192286254D0/ | |
34764 | DATA X(151)/0.161222356068891D0/, A(151)/0.063924238584648D0/ | |
34765 | DATA X(152)/0.097004699209462D0/, A(152)/0.064466164435950D0/ | |
34766 | DATA X(153)/0.032380170962869D0/, A(153)/0.064737696812683D0/ | |
34767 | C-----N=64 | |
34768 | DATA X(154)/0.999305041735772D0/, A(154)/0.001783280721696D0/ | |
34769 | DATA X(155)/0.996340116771955D0/, A(155)/0.004147033260562D0/ | |
34770 | DATA X(156)/0.991013371476744D0/, A(156)/0.006504457968978D0/ | |
34771 | DATA X(157)/0.983336253884625D0/, A(157)/0.008846759826363D0/ | |
34772 | DATA X(158)/0.973326827789910D0/, A(158)/0.011168139460131D0/ | |
34773 | DATA X(159)/0.961008799652053D0/, A(159)/0.013463047896718D0/ | |
34774 | DATA X(160)/0.946411374858402D0/, A(160)/0.015726030476024D0/ | |
34775 | DATA X(161)/0.929569172131939D0/, A(161)/0.017951715775697D0/ | |
34776 | DATA X(162)/0.910522137078502D0/, A(162)/0.020134823153530D0/ | |
34777 | DATA X(163)/0.889315445995114D0/, A(163)/0.022270173808383D0/ | |
34778 | DATA X(164)/0.865999398154092D0/, A(164)/0.024352702568710D0/ | |
34779 | DATA X(165)/0.840629296252580D0/, A(165)/0.026377469715054D0/ | |
34780 | DATA X(166)/0.813265315122797D0/, A(166)/0.028339672614259D0/ | |
34781 | DATA X(167)/0.783972358943341D0/, A(167)/0.030234657072402D0/ | |
34782 | DATA X(168)/0.752819907260531D0/, A(168)/0.032057928354851D0/ | |
34783 | DATA X(169)/0.719881850171610D0/, A(169)/0.033805161837141D0/ | |
34784 | DATA X(170)/0.685236313054233D0/, A(170)/0.035472213256882D0/ | |
34785 | DATA X(171)/0.648965471254657D0/, A(171)/0.037055128540240D0/ | |
34786 | DATA X(172)/0.611155355172393D0/, A(172)/0.038550153178615D0/ | |
34787 | DATA X(173)/0.571895646202634D0/, A(173)/0.039953741132720D0/ | |
34788 | DATA X(174)/0.531279464019894D0/, A(174)/0.041262563242623D0/ | |
34789 | DATA X(175)/0.489403145707052D0/, A(175)/0.042473515123653D0/ | |
34790 | DATA X(176)/0.446366017253464D0/, A(176)/0.043583724529323D0/ | |
34791 | DATA X(177)/0.402270157963991D0/, A(177)/0.044590558163756D0/ | |
34792 | DATA X(178)/0.357220158337668D0/, A(178)/0.045491627927418D0/ | |
34793 | DATA X(179)/0.311322871990210D0/, A(179)/0.046284796581314D0/ | |
34794 | DATA X(180)/0.264687162208767D0/, A(180)/0.046968182816210D0/ | |
34795 | DATA X(181)/0.217423643740007D0/, A(181)/0.047540165714830D0/ | |
34796 | DATA X(182)/0.169644420423992D0/, A(182)/0.047999388596458D0/ | |
34797 | DATA X(183)/0.121462819296120D0/, A(183)/0.048344762234802D0/ | |
34798 | DATA X(184)/0.072993121787799D0/, A(184)/0.048575467441503D0/ | |
34799 | DATA X(185)/0.024350292663424D0/, A(185)/0.048690957009139D0/ | |
34800 | C-----N=80 | |
34801 | DATA X(186)/0.999553822651630D0/, A(186)/0.001144950003186D0/ | |
34802 | DATA X(187)/0.997649864398237D0/, A(187)/0.002663533589512D0/ | |
34803 | DATA X(188)/0.994227540965688D0/, A(188)/0.004180313124694D0/ | |
34804 | DATA X(189)/0.989291302499755D0/, A(189)/0.005690922451403D0/ | |
34805 | DATA X(190)/0.982848572738629D0/, A(190)/0.007192904768117D0/ | |
34806 | DATA X(191)/0.974909140585727D0/, A(191)/0.008683945269260D0/ | |
34807 | DATA X(192)/0.965485089043799D0/, A(192)/0.010161766041103D0/ | |
34808 | DATA X(193)/0.954590766343634D0/, A(193)/0.011624114120797D0/ | |
34809 | DATA X(194)/0.942242761309872D0/, A(194)/0.013068761592401D0/ | |
34810 | DATA X(195)/0.928459877172445D0/, A(195)/0.014493508040509D0/ | |
34811 | DATA X(196)/0.913263102571757D0/, A(196)/0.015896183583725D0/ | |
34812 | DATA X(197)/0.896675579438770D0/, A(197)/0.017274652056269D0/ | |
34813 | DATA X(198)/0.878722567678213D0/, A(198)/0.018626814208299D0/ | |
34814 | DATA X(199)/0.859431406663111D0/, A(199)/0.019950610878141D0/ | |
34815 | DATA X(200)/0.838831473580255D0/, A(200)/0.021244026115782D0/ | |
34816 | DATA X(201)/0.816954138681463D0/, A(201)/0.022505090246332D0/ | |
34817 | DATA X(202)/0.793832717504605D0/, A(202)/0.023731882865930D0/ | |
34818 | DATA X(203)/0.769502420135041D0/, A(203)/0.024922535764115D0/ | |
34819 | DATA X(204)/0.744000297583597D0/, A(204)/0.026075235767565D0/ | |
34820 | DATA X(205)/0.717365185362099D0/, A(205)/0.027188227500486D0/ | |
34821 | DATA X(206)/0.689637644342027D0/, A(206)/0.028259816057276D0/ | |
34822 | DATA X(207)/0.660859898986119D0/, A(207)/0.029288369583267D0/ | |
34823 | DATA X(208)/0.631075773046871D0/, A(208)/0.030272321759557D0/ | |
34824 | DATA X(209)/0.600330622829751D0/, A(209)/0.031210174188114D0/ | |
34825 | DATA X(210)/0.568671268122709D0/, A(210)/0.032100498673487D0/ | |
34826 | DATA X(211)/0.536145920897131D0/, A(211)/0.032941939397645D0/ | |
34827 | DATA X(212)/0.502804111888784D0/, A(212)/0.033733214984611D0/ | |
34828 | DATA X(213)/0.468696615170544D0/, A(213)/0.034473120451753D0/ | |
34829 | DATA X(214)/0.433875370831756D0/, A(214)/0.035160529044747D0/ | |
34830 | DATA X(215)/0.398393405881969D0/, A(215)/0.035794393953416D0/ | |
34831 | DATA X(216)/0.362304753499487D0/, A(216)/0.036373749905835D0/ | |
34832 | DATA X(217)/0.325664370747701D0/, A(217)/0.036897714638276D0/ | |
34833 | DATA X(218)/0.288528054884511D0/, A(218)/0.037365490238730D0/ | |
34834 | DATA X(219)/0.250952358392272D0/, A(219)/0.037776364362001D0/ | |
34835 | DATA X(220)/0.212994502857666D0/, A(220)/0.038129711314477D0/ | |
34836 | DATA X(221)/0.174712291832646D0/, A(221)/0.038424993006959D0/ | |
34837 | DATA X(222)/0.136164022809143D0/, A(222)/0.038661759774076D0/ | |
34838 | DATA X(223)/0.097408398441584D0/, A(223)/0.038839651059051D0/ | |
34839 | DATA X(224)/0.058504437152420D0/, A(224)/0.038958395962769D0/ | |
34840 | DATA X(225)/0.019511383256793D0/, A(225)/0.039017813656306D0/ | |
34841 | C-----N=96 | |
34842 | DATA X(226)/0.999689503883230D0/, A(226)/0.000796792065552D0/ | |
34843 | DATA X(227)/0.998364375863181D0/, A(227)/0.001853960788946D0/ | |
34844 | DATA X(228)/0.995981842987209D0/, A(228)/0.002910731817934D0/ | |
34845 | DATA X(229)/0.992543900323762D0/, A(229)/0.003964554338444D0/ | |
34846 | DATA X(230)/0.988054126329623D0/, A(230)/0.005014202742927D0/ | |
34847 | DATA X(231)/0.982517263563014D0/, A(231)/0.006058545504235D0/ | |
34848 | DATA X(232)/0.975939174585136D0/, A(232)/0.007096470791153D0/ | |
34849 | DATA X(233)/0.968326828463264D0/, A(233)/0.008126876925698D0/ | |
34850 | DATA X(234)/0.959688291448742D0/, A(234)/0.009148671230783D0/ | |
34851 | DATA X(235)/0.950032717784437D0/, A(235)/0.010160770535008D0/ | |
34852 | DATA X(236)/0.939370339752755D0/, A(236)/0.011162102099838D0/ | |
34853 | DATA X(237)/0.927712456722308D0/, A(237)/0.012151604671088D0/ | |
34854 | DATA X(238)/0.915071423120898D0/, A(238)/0.013128229566961D0/ | |
34855 | DATA X(239)/0.901460635315852D0/, A(239)/0.014090941772314D0/ | |
34856 | DATA X(240)/0.886894517402420D0/, A(240)/0.015038721026994D0/ | |
34857 | DATA X(241)/0.871388505909296D0/, A(241)/0.015970562902562D0/ | |
34858 | DATA X(242)/0.854959033434601D0/, A(242)/0.016885479864245D0/ | |
34859 | DATA X(243)/0.837623511228187D0/, A(243)/0.017782502316045D0/ | |
34860 | DATA X(244)/0.819400310737931D0/, A(244)/0.018660679627411D0/ | |
34861 | DATA X(245)/0.800308744139140D0/, A(245)/0.019519081140145D0/ | |
34862 | DATA X(246)/0.780369043867433D0/, A(246)/0.020356797154333D0/ | |
34863 | DATA X(247)/0.759602341176647D0/, A(247)/0.021172939892191D0/ | |
34864 | DATA X(248)/0.738030643744400D0/, A(248)/0.021966644438744D0/ | |
34865 | DATA X(249)/0.715676812348967D0/, A(249)/0.022737069658329D0/ | |
34866 | DATA X(250)/0.692564536642171D0/, A(250)/0.023483399085926D0/ | |
34867 | DATA X(251)/0.668718310043916D0/, A(251)/0.024204841792364D0/ | |
34868 | DATA X(252)/0.644163403784967D0/, A(252)/0.024900633222483D0/ | |
34869 | DATA X(253)/0.618925840125468D0/, A(253)/0.025570036005349D0/ | |
34870 | DATA X(254)/0.593032364777572D0/, A(254)/0.026212340735672D0/ | |
34871 | DATA X(255)/0.566510418561397D0/, A(255)/0.026826866725591D0/ | |
34872 | DATA X(256)/0.539388108324357D0/, A(256)/0.027412962726029D0/ | |
34873 | DATA X(257)/0.511694177154667D0/, A(257)/0.027970007616848D0/ | |
34874 | DATA X(258)/0.483457973920596D0/, A(258)/0.028497411065085D0/ | |
34875 | DATA X(259)/0.454709422167743D0/, A(259)/0.028994614150555D0/ | |
34876 | DATA X(260)/0.425478988407300D0/, A(260)/0.029461089958167D0/ | |
34877 | DATA X(261)/0.395797649828908D0/, A(261)/0.029896344136328D0/ | |
34878 | DATA X(262)/0.365696861472313D0/, A(262)/0.030299915420827D0/ | |
34879 | DATA X(263)/0.335208522892625D0/, A(263)/0.030671376123669D0/ | |
34880 | DATA X(264)/0.304364944354496D0/, A(264)/0.031010332586313D0/ | |
34881 | DATA X(265)/0.273198812591049D0/, A(265)/0.031316425596861D0/ | |
34882 | DATA X(266)/0.241743156163840D0/, A(266)/0.031589330770727D0/ | |
34883 | DATA X(267)/0.210031310460567D0/, A(267)/0.031828758894411D0/ | |
34884 | DATA X(268)/0.178096882367618D0/, A(268)/0.032034456231992D0/ | |
34885 | DATA X(269)/0.145973714654896D0/, A(269)/0.032206204794030D0/ | |
34886 | DATA X(270)/0.113695850110665D0/, A(270)/0.032343822568575D0/ | |
34887 | DATA X(271)/0.081297495464425D0/, A(271)/0.032447163714064D0/ | |
34888 | DATA X(272)/0.048812985136049D0/, A(272)/0.032516118713868D0/ | |
34889 | DATA X(273)/0.016276744849602D0/, A(273)/0.032550614492363D0/ | |
34890 | DATA IBD/0/ | |
34891 | IF(IBD.NE.0) RETURN | |
34892 | IBD=1 | |
34893 | DO 10 I=1,273 | |
34894 | B(I) = A(I) | |
34895 | Y(I) = X(I) | |
34896 | 10 CONTINUE | |
34897 | DO 20 I=1,96 | |
34898 | LTAB(I) = KTAB(I) | |
34899 | 20 CONTINUE | |
34900 | END | |
34901 | ||
34902 | *$ CREATE PHO_DZEROX.FOR | |
34903 | *COPY PHO_DZEROX | |
34904 | CDECK ID>, PHO_DZEROX | |
34905 | DOUBLE PRECISION FUNCTION PHO_DZEROX(A0,B0,EPS,MAXF,F,MODE) | |
34906 | C********************************************************************** | |
34907 | C | |
34908 | C Based on | |
34909 | C | |
34910 | C J.C.P. Bus and T.J. Dekker, Two Efficient Algorithms with | |
34911 | C Guaranteed Convergence for Finding a Zero of a Function, | |
34912 | C ACM Trans. Math. Software 1 (1975) 330-345. | |
34913 | C | |
34914 | C (MODE = 1: Algorithm M; MODE = 2: Algorithm R) | |
34915 | C | |
34916 | C CERNLIB C200 | |
34917 | C | |
34918 | C*********************************************************************** | |
34919 | IMPLICIT DOUBLE PRECISION (A-H,O-Z) | |
34920 | SAVE | |
34921 | ||
34922 | C input/output channels | |
34923 | INTEGER LI,LO | |
34924 | COMMON /POINOU/ LI,LO | |
34925 | ||
34926 | CHARACTER NAME*(*) | |
34927 | PARAMETER (NAME = 'PHO_DZEROX') | |
34928 | LOGICAL LMT | |
34929 | DIMENSION IM1(2),IM2(2),LMT(2) | |
34930 | EXTERNAL F | |
34931 | ||
34932 | PARAMETER (Z1 = 1, HALF = Z1/2) | |
34933 | ||
34934 | DATA IM1 /2,3/, IM2 /-1,3/ | |
34935 | ||
34936 | IF(MODE .NE. 1 .AND. MODE .NE. 2) THEN | |
34937 | C=-2D+10 | |
34938 | WRITE(LO,100) NAME,MODE | |
34939 | GO TO 99 | |
34940 | ENDIF | |
34941 | FA=F(B0) | |
34942 | FB=F(A0) | |
34943 | IF(FA*FB .GT. 0) THEN | |
34944 | C=-3D+10 | |
34945 | WRITE(LO,101) NAME | |
34946 | GO TO 99 | |
34947 | ENDIF | |
34948 | ATL=ABS(EPS) | |
34949 | B=A0 | |
34950 | A=B0 | |
34951 | LMT(2)=.TRUE. | |
34952 | MF=2 | |
34953 | 1 C=A | |
34954 | FC=FA | |
34955 | 2 IE=0 | |
34956 | 3 IF(ABS(FC) .LT. ABS(FB)) THEN | |
34957 | IF(C .NE. A) THEN | |
34958 | D=A | |
34959 | FD=FA | |
34960 | END IF | |
34961 | A=B | |
34962 | B=C | |
34963 | C=A | |
34964 | FA=FB | |
34965 | FB=FC | |
34966 | FC=FA | |
34967 | END IF | |
34968 | TOL=ATL*(1+ABS(C)) | |
34969 | H=HALF*(C+B) | |
34970 | HB=H-B | |
34971 | IF(ABS(HB) .GT. TOL) THEN | |
34972 | IF(IE .GT. IM1(MODE)) THEN | |
34973 | W=HB | |
34974 | ELSE | |
34975 | TOL=TOL*SIGN(Z1,HB) | |
34976 | P=(B-A)*FB | |
34977 | LMT(1)=IE .LE. 1 | |
34978 | IF(LMT(MODE)) THEN | |
34979 | Q=FA-FB | |
34980 | LMT(2)=.FALSE. | |
34981 | ELSE | |
34982 | FDB=(FD-FB)/(D-B) | |
34983 | FDA=(FD-FA)/(D-A) | |
34984 | P=FDA*P | |
34985 | Q=FDB*FA-FDA*FB | |
34986 | END IF | |
34987 | IF(P .LT. 0) THEN | |
34988 | P=-P | |
34989 | Q=-Q | |
34990 | END IF | |
34991 | IF(IE .EQ. IM2(MODE)) P=P+P | |
34992 | IF(P .EQ. 0 .OR. P .LE. Q*TOL) THEN | |
34993 | W=TOL | |
34994 | ELSEIF(P .LT. HB*Q) THEN | |
34995 | W=P/Q | |
34996 | ELSE | |
34997 | W=HB | |
34998 | END IF | |
34999 | END IF | |
35000 | D=A | |
35001 | A=B | |
35002 | FD=FA | |
35003 | FA=FB | |
35004 | B=B+W | |
35005 | MF=MF+1 | |
35006 | IF(MF .GT. MAXF) THEN | |
35007 | WRITE(LO,102) NAME | |
35008 | GO TO 99 | |
35009 | ENDIF | |
35010 | FB=F(B) | |
35011 | IF(FB .EQ. 0 .OR. SIGN(Z1,FC) .EQ. SIGN(Z1,FB)) GO TO 1 | |
35012 | IF(W .EQ. HB) GO TO 2 | |
35013 | IE=IE+1 | |
35014 | GO TO 3 | |
35015 | END IF | |
35016 | 99 CONTINUE | |
35017 | PHO_DZEROX=C | |
35018 | RETURN | |
35019 | 100 FORMAT(1X,A,': mode = ',I3,' illegal') | |
35020 | 101 FORMAT(1X,A,': F(A) and F(B) have the same sign') | |
35021 | 102 FORMAT(1X,A,': too many function calls') | |
35022 | ||
35023 | END | |
35024 | ||
35025 | *$ CREATE PHO_EXPINT.FOR | |
35026 | *COPY PHO_EXPINT | |
35027 | CDECK ID>, PHO_EXPINT | |
35028 | DOUBLE PRECISION FUNCTION PHO_EXPINT(RXM) | |
35029 | C*********************************************************************** | |
35030 | C | |
35031 | C function to calculate E_i(x) = -E_1(-x) | |
35032 | C | |
35033 | C based on CERNLIB C337 (changed by R.Engel 10/1993) | |
35034 | C | |
35035 | C*********************************************************************** | |
35036 | IMPLICIT DOUBLE PRECISION (A-H,O-Z) | |
35037 | SAVE | |
35038 | ||
35039 | C input/output channels | |
35040 | INTEGER LI,LO | |
35041 | COMMON /POINOU/ LI,LO | |
35042 | ||
35043 | DOUBLE PRECISION P1(5),Q1(5),P2(7),Q2(7),P3(6),Q3(6),P4(8),Q4(8) | |
35044 | DOUBLE PRECISION A1(8),B1(8),A2(8),B2(8),A3(6),B3(6),XL(6) | |
35045 | DOUBLE PRECISION X,Y,AP,BP,DP,AQ,BQ,DQ,X0,V | |
35046 | ||
35047 | DATA X0 /0.37250 74107 8137D0/ | |
35048 | DATA XL /-24.0D0,-12.0D0,-6.0D0,0.0D0,1.0D0,4.0D0/ | |
35049 | DATA P1 | |
35050 | 1/+4.29312 52343 210D+0, +3.98941 53870 321D+1, | |
35051 | 2 +2.92525 18866 921D+2, +4.25696 82638 592D+2, | |
35052 | 3 -4.34981 43832 952D+2/ | |
35053 | DATA Q1 | |
35054 | 1/+1.00000 00000 000D+0, +1.88992 88395 003D+1, | |
35055 | 2 +1.50950 38744 251D+2, +5.68052 52718 987D+2, | |
35056 | 3 +7.53585 64359 843D+2/ | |
35057 | DATA P2 | |
35058 | 1/+4.30967 83946 939D-1, +6.90522 52278 444D+0, | |
35059 | 2 +2.30192 55939 133D+1, +2.43784 08879 132D+1, | |
35060 | 3 +9.04161 55694 633D+0, +9.99979 57705 159D-1, | |
35061 | 4 +4.65627 10797 510D-7/ | |
35062 | DATA Q2 | |
35063 | 1/+1.03400 13040 487D-1, +3.31909 21359 330D+0, | |
35064 | 2 +2.04494 78501 379D+1, +4.12807 84189 142D+1, | |
35065 | 3 +3.24264 21069 514D+1, +1.00411 64382 905D+1, | |
35066 | 4 +1.00000 00000 000D+0/ | |
35067 | DATA P3 | |
35068 | 1/-2.39099 64453 136D+0, -1.47982 19500 504D+2, | |
35069 | 2 -2.54376 33976 890D+2, -1.19557 61038 372D+2, | |
35070 | 3 -1.96304 08535 939D+1, -9.99999 99990 360D-1/ | |
35071 | DATA Q3 | |
35072 | 1/+1.77600 70940 351D+2, +5.30685 09610 812D+2, | |
35073 | 2 +4.62230 27156 148D+2, +1.56818 43364 539D+2, | |
35074 | 3 +2.16304 08494 238D+1, +1.00000 00000 000D+0/ | |
35075 | DATA P4 | |
35076 | 1/-8.66937 33995 107D+0, -5.49142 26552 109D+2, | |
35077 | 2 -4.21001 61535 707D+3, -2.49301 39345 865D+5, | |
35078 | 3 -1.19623 66934 925D+5, -2.21744 62775 885D+7, | |
35079 | 4 +3.89280 42131 120D+6, -3.91546 07380 910D+8/ | |
35080 | DATA Q4 | |
35081 | 1/+3.41718 75000 000D+1, -1.60708 92658 722D+3, | |
35082 | 2 +3.57300 29805 851D+4, -4.83547 43616 216D+5, | |
35083 | 3 +4.28559 62461 175D+6, -2.49033 37574 054D+7, | |
35084 | 4 +8.91925 76757 561D+7, -1.65254 29972 521D+8/ | |
35085 | DATA A1 | |
35086 | 1/-2.18086 38152 072D+0, -2.19010 23385 488D+1, | |
35087 | 2 +9.30816 38566 217D+0, +2.50762 81129 356D+1, | |
35088 | 3 -3.31842 53199 722D+1, +6.01217 99083 008D+1, | |
35089 | 4 -4.32531 13287 813D+1, +1.00443 10922 808D+0/ | |
35090 | DATA B1 | |
35091 | 1/+0.00000 00000 000D+0, +3.93707 70185 272D+0, | |
35092 | 2 +3.00892 64837 292D+2, -6.25041 16167 188D+0, | |
35093 | 3 +1.00367 43951 673D+3, +1.43256 73812 194D+1, | |
35094 | 4 +2.73624 11988 933D+3, +5.27468 85196 291D-1/ | |
35095 | DATA A2 | |
35096 | 1/-3.48334 65360 285D+0, -1.86545 45488 340D+1, | |
35097 | 2 -8.28561 99414 064D+0, -3.23467 33030 540D+1, | |
35098 | 3 +1.79601 68876 925D+1, +1.75656 31546 961D+0, | |
35099 | 4 -1.95022 32128 966D+0, +9.99994 29607 471D-1/ | |
35100 | DATA B2 | |
35101 | 1/+0.00000 00000 000D+0, +6.95000 65588 743D+1, | |
35102 | 2 +5.72837 19383 732D+1, +2.57776 38423 844D+1, | |
35103 | 3 +7.60761 14800 773D+2, +2.89516 72792 514D+1, | |
35104 | 4 -3.43942 26689 987D+0, +1.00083 86740 264D+0/ | |
35105 | DATA A3 | |
35106 | 1/-2.77809 28934 438D+1, -1.01047 90815 760D+1, | |
35107 | 2 -9.14830 08216 736D+0, -5.02233 17461 851D+0, | |
35108 | 3 -3.00000 77799 358D+0, +1.00000 00000 704D+0/ | |
35109 | DATA B3 | |
35110 | 1/+0.00000 00000 000D+0, +1.22399 93926 823D+2, | |
35111 | 2 +2.72761 00778 779D+0, -7.18975 18395 045D+0, | |
35112 | 3 -2.99901 18065 262D+0, +1.99999 99428 260D+0/ | |
35113 | C | |
35114 | C conversion to E_i function | |
35115 | X = -RXM | |
35116 | C | |
35117 | IF(X .LE. XL(1)) THEN | |
35118 | AP=A3(1)-X | |
35119 | DO 1 I = 2,5 | |
35120 | 1 AP=A3(I)-X+B3(I)/AP | |
35121 | Y=(EXP(-X)/X)*(1.D0-(A3(6)+B3(6)/AP)/X) | |
35122 | ELSEIF(X .LE. XL(2)) THEN | |
35123 | AP=A2(1)-X | |
35124 | DO 2 I = 2,7 | |
35125 | 2 AP=A2(I)-X+B2(I)/AP | |
35126 | Y=(EXP(-X)/X)*(A2(8)+B2(8)/AP) | |
35127 | ELSEIF(X .LE. XL(3)) THEN | |
35128 | AP=A1(1)-X | |
35129 | DO 3 I = 2,7 | |
35130 | 3 AP=A1(I)-X+B1(I)/AP | |
35131 | Y=(EXP(-X)/X)*(A1(8)+B1(8)/AP) | |
35132 | ELSEIF(X .LT. XL(4)) THEN | |
35133 | V=-2.D0*(X/3.D0+1.D0) | |
35134 | BP=0.D0 | |
35135 | DP=P4(1) | |
35136 | DO 4 I = 2,8 | |
35137 | AP=BP | |
35138 | BP=DP | |
35139 | 4 DP=P4(I)-AP+V*BP | |
35140 | BQ=0.D0 | |
35141 | DQ=Q4(1) | |
35142 | DO 14 I = 2,8 | |
35143 | AQ=BQ | |
35144 | BQ=DQ | |
35145 | 14 DQ=Q4(I)-AQ+V*BQ | |
35146 | Y=-LOG(-X/X0)+(X+X0)*(DP-AP)/(DQ-AQ) | |
35147 | ELSEIF(X .EQ. XL(4)) THEN | |
35148 | * CALL KERMTR('C337.1',LGFILE,MFLAG,RFLAG) | |
35149 | * IF(MFLAG) THEN | |
35150 | * IF(LGFILE .EQ. 0) THEN | |
35151 | * WRITE(LO,100) ENAME | |
35152 | * ELSE | |
35153 | * WRITE(LGFILE,100) ENAME | |
35154 | * ENDIF | |
35155 | * ENDIF | |
35156 | * IF(.NOT.RFLAG) CALL ABEND | |
35157 | PHO_EXPINT=0.D0 | |
35158 | RETURN | |
35159 | ELSEIF(X .LT. XL(5)) THEN | |
35160 | AP=P1(1) | |
35161 | AQ=Q1(1) | |
35162 | DO 5 I = 2,5 | |
35163 | AP=P1(I)+X*AP | |
35164 | 5 AQ=Q1(I)+X*AQ | |
35165 | Y=-LOG(X)+AP/AQ | |
35166 | ELSEIF(X .LE. XL(6)) THEN | |
35167 | Y=1.D0/X | |
35168 | AP=P2(1) | |
35169 | AQ=Q2(1) | |
35170 | DO 6 I = 2,7 | |
35171 | AP=P2(I)+Y*AP | |
35172 | 6 AQ=Q2(I)+Y*AQ | |
35173 | Y=EXP(-X)*AP/AQ | |
35174 | ELSE | |
35175 | Y=1.D0/X | |
35176 | AP=P3(1) | |
35177 | AQ=Q3(1) | |
35178 | DO 7 I = 2,6 | |
35179 | AP=P3(I)+Y*AP | |
35180 | 7 AQ=Q3(I)+Y*AQ | |
35181 | Y=EXP(-X)*Y*(1.D0+Y*AP/AQ) | |
35182 | ENDIF | |
35183 | C sign conversion to E_i | |
35184 | PHO_EXPINT=-Y | |
35185 | ||
35186 | END | |
35187 | ||
35188 | *$ CREATE PHO_RNDBET.FOR | |
35189 | *COPY PHO_RNDBET | |
35190 | CDECK ID>, PHO_RNDBET | |
35191 | DOUBLE PRECISION FUNCTION PHO_RNDBET(GAM,ETA) | |
35192 | C******************************************************************** | |
35193 | C | |
35194 | C RANDOM NUMBER GENERATION FROM BETA | |
35195 | C DISTRIBUTION IN REGION 0 < X < 1. | |
35196 | C F(X) = X**(GAM-1.)*(1.-X)**(ETA-1)*GAMM(ETA+GAM) / (GAMM(GAM | |
35197 | C *GAMM(ETA)) | |
35198 | C | |
35199 | C******************************************************************** | |
35200 | IMPLICIT DOUBLE PRECISION (A-H,O-Z) | |
35201 | SAVE | |
35202 | ||
35203 | Y = PHO_RNDGAM(1.D0,GAM) | |
35204 | Z = PHO_RNDGAM(1.D0,ETA) | |
35205 | ||
35206 | PHO_RNDBET = Y/(Y+Z) | |
35207 | ||
35208 | END | |
35209 | ||
35210 | *$ CREATE PHO_RNDGAM.FOR | |
35211 | *COPY PHO_RNDGAM | |
35212 | CDECK ID>, PHO_RNDGAM | |
35213 | DOUBLE PRECISION FUNCTION PHO_RNDGAM(ALAM,ETA) | |
35214 | C******************************************************************** | |
35215 | C | |
35216 | C RANDOM NUMBER SELECTION FROM GAMMA DISTRIBUTION | |
35217 | C F(X) = ALAM**ETA*X**(ETA-1)*EXP(-ALAM*X) / GAM(ETA) | |
35218 | C | |
35219 | C******************************************************************** | |
35220 | IMPLICIT DOUBLE PRECISION (A-H,O-Z) | |
35221 | SAVE | |
35222 | C | |
35223 | NCOU=0 | |
35224 | N = ETA | |
35225 | F = ETA - N | |
35226 | IF(F.EQ.0.D0) GOTO 20 | |
35227 | 10 R = DT_RNDM(ETA) | |
35228 | NCOU=NCOU+1 | |
35229 | IF (NCOU.GE.11) GOTO 20 | |
35230 | IF(R.LT.F/(F+2.71828D0)) GOTO 30 | |
35231 | YYY=LOG(DT_RNDM(F)+1.0D-9)/F | |
35232 | IF(ABS(YYY).GT.50.D0) GOTO 20 | |
35233 | Y = EXP(YYY) | |
35234 | IF(LOG(DT_RNDM(Y)+1.0D-9).GT.-Y) GOTO 10 | |
35235 | GOTO 40 | |
35236 | 20 Y = 0.D0 | |
35237 | GOTO 50 | |
35238 | 30 Y = 1.D0-LOG(DT_RNDM(R)+1.0D-9) | |
35239 | IF(DT_RNDM(Y).GT.Y**(F-1.D0)) GOTO 10 | |
35240 | 40 IF(N.EQ.0) GOTO 70 | |
35241 | 50 Z = 1.D0 | |
35242 | DO 60 I = 1,N | |
35243 | 60 Z = Z*DT_RNDM(Y) | |
35244 | Y = Y-LOG(Z+1.0D-9) | |
35245 | 70 PHO_RNDGAM = Y/ALAM | |
35246 | RETURN | |
35247 | END | |
35248 | ||
35249 | *$ CREATE PHO_SFECFE.FOR | |
35250 | *COPY PHO_SFECFE | |
35251 | CDECK ID>, PHO_SFECFE | |
35252 | SUBROUTINE PHO_SFECFE(SFE,CFE) | |
35253 | C********************************************************************** | |
35254 | C | |
35255 | C fast random SIN(X) COS(X) selection | |
35256 | C | |
35257 | C********************************************************************** | |
35258 | IMPLICIT DOUBLE PRECISION (A-H,O-Z) | |
35259 | SAVE | |
35260 | C | |
35261 | 1 CONTINUE | |
35262 | X=DT_RNDM(XX) | |
35263 | Y=DT_RNDM(YY) | |
35264 | XX=X*X | |
35265 | YY=Y*Y | |
35266 | XY=XX+YY | |
35267 | IF(XY.GT.1.D0) GOTO 1 | |
35268 | CFE=(XX-YY)/XY | |
35269 | SFE=2.D0*X*Y/XY | |
35270 | IF(DT_RNDM(XY).LT.0.5D0) THEN | |
35271 | SFE=-SFE | |
35272 | ENDIF | |
35273 | END | |
35274 | ||
35275 | *$ CREATE PHO_SWAPD.FOR | |
35276 | *COPY PHO_SWAPD | |
35277 | CDECK ID>, PHO_SWAPD | |
35278 | SUBROUTINE PHO_SWAPD(D1,D2) | |
35279 | C******************************************************************** | |
35280 | C | |
35281 | C exchange of argument values (double precision) | |
35282 | C | |
35283 | C******************************************************************** | |
35284 | IMPLICIT DOUBLE PRECISION (A-H,O-Z) | |
35285 | D = D1 | |
35286 | D1 = D2 | |
35287 | D2 = D | |
35288 | END | |
35289 | ||
35290 | *$ CREATE PHO_SWAPI.FOR | |
35291 | *COPY PHO_SWAPI | |
35292 | CDECK ID>, PHO_SWAPI | |
35293 | SUBROUTINE PHO_SWAPI(I1,I2) | |
35294 | C******************************************************************** | |
35295 | C | |
35296 | C exchange of argument values (integer) | |
35297 | C | |
35298 | C******************************************************************** | |
35299 | IMPLICIT DOUBLE PRECISION (A-H,O-Z) | |
35300 | K = I1 | |
35301 | I1 = I2 | |
35302 | I2 = K | |
35303 | END | |
35304 | ||
35305 | *$ CREATE PHO_HADCSL.FOR | |
35306 | *COPY PHO_HADCSL | |
35307 | CDECK ID>, PHO_HADCSL | |
35308 | SUBROUTINE PHO_HADCSL(ID1,ID2,ECM,PLAB,IMODE, | |
35309 | & SIGTOT,SIGEL,SIGDIF,SLOPE,RHO) | |
35310 | C*********************************************************************** | |
35311 | C | |
35312 | C low-energy cross section parametrizations | |
35313 | C | |
35314 | C input: ID1,ID2 PDG IDs of particles (meson first) | |
35315 | C ECM c.m. energy (GeV) | |
35316 | C PLAB lab. momentum (second particle at rest) | |
35317 | C IMODE 1 ECM given, PLAB ignored | |
35318 | C 2 PLAB given, ECM ignored | |
35319 | C | |
35320 | C output: SIGTOT total cross section (mb) | |
35321 | C SIGEL elastic cross section (mb) | |
35322 | C SIGDIF diffracive cross section (sd-1,sd-2,dd), (mb) | |
35323 | C SLOPE forward elastic slope (GeV**-2) | |
35324 | C RHO real/imaginary part of elastic amplitude | |
35325 | C | |
35326 | C comments: | |
35327 | C | |
35328 | C - low-energy data interpolation uses PDG fits from 1992 issue | |
35329 | C - high-energy extrapolation by Donnachie-Landshoff like fit made | |
35330 | C by PDG 1996 | |
35331 | C - analytic extension of amplitude to calculate rho | |
35332 | C | |
35333 | C*********************************************************************** | |
35334 | IMPLICIT NONE | |
35335 | SAVE | |
35336 | ||
35337 | INTEGER ID1,ID2,IMODE | |
35338 | DOUBLE PRECISION ECM,PLAB,SIGTOT,SIGEL,SIGDIF(3),SLOPE,RHO | |
35339 | ||
35340 | C input/output channels | |
35341 | INTEGER LI,LO | |
35342 | COMMON /POINOU/ LI,LO | |
35343 | C some constants | |
35344 | DOUBLE PRECISION PI,PI2,PI4,GEV2MB,Q_ch,Q_ch2,Q_ch4 | |
35345 | COMMON /POCONS/ PI,PI2,PI4,GEV2MB, | |
35346 | & Q_ch(-6:6),Q_ch2(-6:6),Q_ch4(-6:6) | |
35347 | C model switches and parameters | |
35348 | CHARACTER*8 MDLNA | |
35349 | INTEGER ISWMDL,IPAMDL | |
35350 | DOUBLE PRECISION PARMDL | |
35351 | COMMON /POMDLS/ MDLNA(50),ISWMDL(50),PARMDL(400),IPAMDL(400) | |
35352 | ||
35353 | INTEGER K | |
35354 | DOUBLE PRECISION SIGTO1,SIGTO2,SIGEL1,SIGEL2, | |
35355 | & SS,PL,PLL,E1,XP,YP,YM,PHR,PHP,X1,X2 | |
35356 | ||
35357 | DOUBLE PRECISION TPDG92(7,2,6),TPDG96(9,6),BURQ83(3,6),XMA(6) | |
35358 | ||
35359 | DATA TPDG92 / | |
35360 | & 3.D0, 2100.D0, 48.D0, 0.D0, 1.D0, 0.522D0, -4.51D0, | |
35361 | & 3.D0, 2100.D0, 11.9D0, 26.9D0, -1.21D0, 0.169D0, -1.85D0, | |
35362 | & 5.D0, 2100.D0, 38.4D0, 77.6D0, -0.64D0, 0.26D0, -1.2D0, | |
35363 | & 5.D0, 2100.D0, 10.2D0, 52.7D0, -1.16D0, 0.125D0, -1.28D0, | |
35364 | & 4.D0, 340.D0, 16.4D0, 19.3D0, -0.42D0, 0.19D0, 0.D0, | |
35365 | & 4.D0, 340.D0, 0.D0, 11.4D0, -0.4D0, 0.079D0, 0.D0, | |
35366 | & 2.5D0, 370.D0, 33.D0, 14.D0, -1.36D0, 0.456D0, -4.03D0, | |
35367 | & 2.5D0, 370.D0, 1.76D0, 11.2D0, -0.64D0, 0.043D0, 0.D0, | |
35368 | & 2.D0, 310.D0, 18.1D0, 0.D0, 1.D0, 0.26D0, -1.D0, | |
35369 | & 2.D0, 310.D0, 5.D0, 8.1D0, -1.8D0, 0.16D0, -1.3D0, | |
35370 | & 3.D0, 310.D0, 32.1D0, 0.D0, 1.D0, 0.66D0, -5.6D0, | |
35371 | & 3.D0, 310.D0, 7.3D0, 0.D0, 1.D0, 0.29D0, -2.4D0 / | |
35372 | ||
35373 | DATA TPDG96 / | |
35374 | & 50.D0, 22.D0,0.079D0,0.25D0,0.D0, | |
35375 | & 77.15D0,-21.05D0,0.46D0,0.9D0, | |
35376 | & 50.D0, 22.D0,0.079D0,0.25D0,0.D0, | |
35377 | & 77.15D0,21.05D0,0.46D0,0.9D0, | |
35378 | & 10.D0, 13.70,0.079D0,0.25D0,0.D0, | |
35379 | & 31.85D0,-4.05D0,0.45D0,0.9D0, | |
35380 | & 10.D0, 13.70,0.079D0,0.25D0,0.D0, | |
35381 | & 31.85D0,4.05D0,0.45D0,0.9D0, | |
35382 | & 10.D0, 12.20,0.079D0,0.25D0,0.D0, | |
35383 | & 17.35D0,-9.05D0,0.50D0,0.9D0, | |
35384 | & 10.D0, 12.20,0.079D0,0.25D0,0.D0, | |
35385 | & 17.35D0,9.05D0,0.50D0,0.9D0 / | |
35386 | ||
35387 | DATA BURQ83 / | |
35388 | & 11.13D0, -6.21D0, 0.30D0, | |
35389 | & 11.13D0, 7.23D0, 0.30D0, | |
35390 | & 9.11D0, -0.73D0, 0.28D0, | |
35391 | & 9.11D0, 0.65D0, 0.28D0, | |
35392 | & 8.55D0, -5.98D0, 0.28D0, | |
35393 | & 8.55D0, 1.60D0, 0.28D0 / | |
35394 | ||
35395 | DATA XMA / | |
35396 | & 2*0.93956563D0, 2*0.13956995D0, 2*0.493677D0 / | |
35397 | ||
35398 | C find index | |
35399 | IF(ID2.NE.2212) THEN | |
35400 | GOTO 100 | |
35401 | ELSE IF(ID1.EQ.2212) THEN | |
35402 | K = 1 | |
35403 | ELSE IF(ID1.EQ.-2212) THEN | |
35404 | K = 2 | |
35405 | ELSE IF(ID1.EQ.211) THEN | |
35406 | K = 3 | |
35407 | ELSE IF(ID1.EQ.-211) THEN | |
35408 | K = 4 | |
35409 | ELSE IF(ID1.EQ.321) THEN | |
35410 | K = 5 | |
35411 | ELSE IF(ID1.EQ.-321) THEN | |
35412 | K = 6 | |
35413 | ELSE | |
35414 | GOTO 100 | |
35415 | ENDIF | |
35416 | ||
35417 | C calculate lab momentum | |
35418 | IF(IMODE.EQ.1) THEN | |
35419 | SS = ECM**2 | |
35420 | E1 = 0.5D0/XMA(1)*(SS-XMA(1)**2-XMA(K)**2) | |
35421 | PL = SQRT(E1*E1-XMA(K)**2) | |
35422 | ELSE IF(IMODE.EQ.2) THEN | |
35423 | PL = PLAB | |
35424 | SS = XMA(1)**2+XMA(K)**2+2.D0*XMA(1)*SQRT(PL**2+XMA(K)**2) | |
35425 | ECM = SQRT(SS) | |
35426 | ELSE | |
35427 | WRITE(LO,'(1X,A,I5)') 'PHO_HADCSL:ERROR: invalid IMODE: ',IMODE | |
35428 | RETURN | |
35429 | ENDIF | |
35430 | PLL = LOG(PL) | |
35431 | ||
35432 | C check against lower limit | |
35433 | IF(ECM.LE.XMA(1)+XMA(K)) GOTO 200 | |
35434 | ||
35435 | XP = TPDG96(2,K)*SS**TPDG96(3,K) | |
35436 | YP = TPDG96(6,K)/SS**TPDG96(8,K) | |
35437 | YM = TPDG96(7,K)/SS**TPDG96(8,K) | |
35438 | ||
35439 | PHR = TAN(PI/2.D0*(1.-TPDG96(8,K))) | |
35440 | PHP = TAN(PI/2.D0*(1.+TPDG96(3,K))) | |
35441 | RHO = (-YP/PHR + YM*PHR - XP/PHP)/(YP+YM+XP) | |
35442 | SLOPE = BURQ83(1,K)+BURQ83(2,K)/SQRT(PL)+BURQ83(3,K)*PLL | |
35443 | ||
35444 | C select energy range and interpolation method | |
35445 | IF(PL.LT.TPDG96(1,K)) THEN | |
35446 | SIGTOT = TPDG92(3,1,K)+TPDG92(4,1,K)*PL**TPDG92(5,1,K) | |
35447 | & + TPDG92(6,1,K)*PLL**2+TPDG92(7,1,K)*PLL | |
35448 | SIGEL = TPDG92(3,2,K)+TPDG92(4,2,K)*PL**TPDG92(5,2,K) | |
35449 | & + TPDG92(6,2,K)*PLL**2+TPDG92(7,2,K)*PLL | |
35450 | ELSE IF(PL.LT.TPDG92(2,1,K)) THEN | |
35451 | SIGTO1 = TPDG92(3,1,K)+TPDG92(4,1,K)*PL**TPDG92(5,1,K) | |
35452 | & + TPDG92(6,1,K)*PLL**2+TPDG92(7,1,K)*PLL | |
35453 | SIGEL1 = TPDG92(3,2,K)+TPDG92(4,2,K)*PL**TPDG92(5,2,K) | |
35454 | & + TPDG92(6,2,K)*PLL**2+TPDG92(7,2,K)*PLL | |
35455 | SIGTO2 = YP+YM+XP | |
35456 | SIGEL2 = SIGTO2**2/(16.D0*PI*SLOPE*GEV2MB)*(1.D0+RHO**2) | |
35457 | X2 = LOG(PL/TPDG96(1,K))/LOG(TPDG92(2,1,K)/TPDG96(1,K)) | |
35458 | X1 = 1.D0 - X2 | |
35459 | SIGTOT = SIGTO2*X2 + SIGTO1*X1 | |
35460 | SIGEL = SIGEL2*X2 + SIGEL1*X1 | |
35461 | ELSE | |
35462 | SIGTOT = YP+YM+XP | |
35463 | SIGEL = SIGTOT**2/(16.D0*PI*SLOPE*GEV2MB)*(1.D0+RHO**2) | |
35464 | ENDIF | |
35465 | ||
35466 | C no parametrization of diffraction implemented | |
35467 | SIGDIF(1) = -1.D0 | |
35468 | SIGDIF(2) = -1.D0 | |
35469 | SIGDIF(3) = -1.D0 | |
35470 | ||
35471 | RETURN | |
35472 | ||
35473 | 100 CONTINUE | |
35474 | WRITE(LO,'(1X,2A,2I7)') 'PHO_HADCSL:ERROR: ', | |
35475 | & 'invalid particle combination: ',ID1,ID2 | |
35476 | RETURN | |
35477 | ||
35478 | 200 CONTINUE | |
35479 | WRITE(LO,'(1X,2A,1P,2E12.4)') 'PHO_HADCSL:ERROR: ', | |
35480 | & 'energy too small (Ecm,Plab): ',ECM,PLAB | |
35481 | ||
35482 | END | |
35483 | ||
35484 | *$ CREATE PHO_CSDIFF.FOR | |
35485 | *COPY PHO_CSDIFF | |
35486 | CDECK ID>, PHO_CSDIFF | |
35487 | SUBROUTINE PHO_CSDIFF(Id1,Id2,SS,Xi_min,Xi_max, | |
35488 | & sig_sd1,sig_sd2,sig_dd) | |
35489 | C*********************************************************************** | |
35490 | C | |
35491 | C cross section for diffraction dissociation according to | |
35492 | C Goulianos' parametrization (Ref: PL B358 (1995) 379) | |
35493 | C | |
35494 | C in addition rescaling for different particles is applied using | |
35495 | C internal rescaling tables (not implemented yet) | |
35496 | C | |
35497 | C input: Id1/2 PDG ID's of incoming particles | |
35498 | C SS squared c.m. energy (GeV**2) | |
35499 | C Xi_min min. diff mass (squared) = Xi_min*SS | |
35500 | C Xi_max max. diff mass (squared) = Xi_max*SS | |
35501 | C | |
35502 | C output: sig_sd1 cross section for diss. of particle 1 (mb) | |
35503 | C sig_sd2 cross section for diss. of particle 2 (mb) | |
35504 | C sig_dd cross section for diss. of both particles | |
35505 | C | |
35506 | C*********************************************************************** | |
35507 | IMPLICIT NONE | |
35508 | SAVE | |
35509 | ||
35510 | INTEGER Id1,Id2 | |
35511 | DOUBLE PRECISION SS,Xi_min,Xi_max,sig_sd1,sig_sd2,sig_dd | |
35512 | ||
35513 | C input/output channels | |
35514 | INTEGER LI,LO | |
35515 | COMMON /POINOU/ LI,LO | |
35516 | C some constants | |
35517 | DOUBLE PRECISION PI,PI2,PI4,GEV2MB,Q_ch,Q_ch2,Q_ch4 | |
35518 | COMMON /POCONS/ PI,PI2,PI4,GEV2MB, | |
35519 | & Q_ch(-6:6),Q_ch2(-6:6),Q_ch4(-6:6) | |
35520 | ||
35521 | DOUBLE PRECISION xpos1(96),xwgh1(96),xpos2(96),xwgh2(96) | |
35522 | DOUBLE PRECISION delta,alphap,beta0,gpom0,xm_p,x_rad2,xm4_p2, | |
35523 | & fac,tt,t1,t2,tl,tu,Xnorm,xi,xil,xiu,w_xi,alpha_t,f2_t, | |
35524 | & xms_1,xms_2,CSdiff | |
35525 | ||
35526 | INTEGER Ngau1,Ngau2,i1,i2 | |
35527 | ||
35528 | C model parameters | |
35529 | ||
35530 | DATA delta / 0.104d0 / | |
35531 | DATA alphap / 0.25d0 / | |
35532 | DATA beta0 / 6.56d0 / | |
35533 | DATA gpom0 / 1.21d0 / | |
35534 | DATA xm_p / 0.938d0 / | |
35535 | DATA x_rad2 / 0.71d0 / | |
35536 | ||
35537 | C integration precision | |
35538 | ||
35539 | DATA Ngau1 / 96 / | |
35540 | DATA Ngau2 / 96 / | |
35541 | ||
35542 | sig_sd1 = 0.d0 | |
35543 | sig_sd2 = 0.d0 | |
35544 | sig_dd = 0.d0 | |
35545 | ||
35546 | IF ((ABS(id1).EQ.2212).AND.(ABS(id2).EQ.2212)) THEN | |
35547 | ||
35548 | xm4_p2 = 4.D0*xm_p**2 | |
35549 | fac = beta0**2/(16.D0*PI) | |
35550 | ||
35551 | t1 = -5.D0 | |
35552 | t2 = 0.D0 | |
35553 | tl = x_rad2/3.D0/(1.D0-t1/x_rad2)**3 | |
35554 | tu = x_rad2/3.D0/(1.D0-t2/x_rad2)**3 | |
35555 | ||
35556 | C flux renormalization and cross section | |
35557 | ||
35558 | Xnorm = 0.d0 | |
35559 | ||
35560 | xil = log(1.5d0/SS) | |
35561 | xiu = log(0.1d0) | |
35562 | ||
35563 | IF(xiu.LE.xil) goto 1000 | |
35564 | ||
35565 | CALL PHO_GAUSET(xil,xiu,Ngau1,xpos1,xwgh1) | |
35566 | CALL PHO_GAUSET(tl,tu,Ngau2,xpos2,xwgh2) | |
35567 | ||
35568 | do i1=1,Ngau1 | |
35569 | ||
35570 | xi = exp(xpos1(i1)) | |
35571 | w_xi = Xwgh1(i1) | |
35572 | ||
35573 | do i2=1,Ngau2 | |
35574 | ||
35575 | tt = x_rad2-x_rad2*(x_rad2/(3.D0*xpos2(i2)))**(1.D0/3.D0) | |
35576 | ||
35577 | alpha_t = 1.D0+delta+alphap*tt | |
35578 | f2_t = ((xm4_p2-2.8D0*tt)/(xm4_p2-tt))**2 | |
35579 | ||
35580 | Xnorm = Xnorm | |
35581 | & + f2_t*xi**(2.D0-2.d0*alpha_t)*Xwgh2(i2)*w_xi | |
35582 | ||
35583 | enddo | |
35584 | enddo | |
35585 | ||
35586 | Xnorm = Xnorm*fac | |
35587 | ||
35588 | 1000 continue | |
35589 | ||
35590 | XIL = LOG(Xi_min) | |
35591 | XIU = LOG(Xi_max) | |
35592 | ||
35593 | T1 = -5.D0 | |
35594 | T2 = 0.D0 | |
35595 | ||
35596 | TL = x_rad2/3.D0/(1.D0-t1/x_rad2)**3 | |
35597 | TU = x_rad2/3.D0/(1.D0-t2/x_rad2)**3 | |
35598 | ||
35599 | C single diffraction diss. cross section | |
35600 | ||
35601 | CSdiff = 0.d0 | |
35602 | ||
35603 | IF(XIU.LE.XIL) goto 2000 | |
35604 | ||
35605 | CALL PHO_GAUSET(XIL,XIU,NGAU1,XPOS1,XWGH1) | |
35606 | CALL PHO_GAUSET(TL,TU,NGAU2,XPOS2,XWGH2) | |
35607 | ||
35608 | do i1=1,Ngau1 | |
35609 | ||
35610 | xi = exp(xpos1(i1)) | |
35611 | w_xi = Xwgh1(i1)*beta0*gpom0*(xi*ss)**delta | |
35612 | ||
35613 | do i2=1,Ngau2 | |
35614 | ||
35615 | tt = x_rad2-x_rad2*(x_rad2/(3.D0*xpos2(i2)))**(1.D0/3.D0) | |
35616 | ||
35617 | alpha_t = 1.D0+delta+alphap*tt | |
35618 | f2_t = ((xm4_p2-2.8D0*tt)/(xm4_p2-tt))**2 | |
35619 | ||
35620 | CSdiff = CSdiff | |
35621 | & + f2_t*xi**(2.D0-2.d0*alpha_t)*Xwgh2(i2)*w_xi | |
35622 | ||
35623 | enddo | |
35624 | enddo | |
35625 | ||
35626 | CSdiff = CSdiff*fac*GEV2MB/MAX(1.d0,Xnorm) | |
35627 | ||
35628 | * WRITE(LO,'(1x,1p,4e14.3)') | |
35629 | * & sqrt(SS),Xnorm,2.*CSdiff*MAX(1.d0,Xnorm),2.*CSdiff | |
35630 | ||
35631 | sig_sd1 = CSdiff | |
35632 | sig_sd2 = CSdiff | |
35633 | ||
35634 | 2000 continue | |
35635 | ||
35636 | C double diffraction dissociation cross section | |
35637 | ||
35638 | CSdiff = 0.d0 | |
35639 | ||
35640 | xil = log(1.5d0/SS) | |
35641 | xiu = log(Xi_max/1.5d0) | |
35642 | ||
35643 | IF(xiu.LE.xil) goto 3000 | |
35644 | ||
35645 | fac = (beta0*gpom0*SS**delta | |
35646 | & /(4.d0*sqrt(PI)*MAX(1.d0,Xnorm)))**2 | |
35647 | & /(2.d0*alphap) | |
35648 | ||
35649 | CALL PHO_GAUSET(xil,xiu,ngau1,xpos1,xwgh1) | |
35650 | ||
35651 | do i1=1,Ngau1 | |
35652 | ||
35653 | xi = exp(xpos1(i1)) | |
35654 | xms_1 = xi*SS | |
35655 | ||
35656 | xiu = log(Xi_max/(xi*SS)) | |
35657 | ||
35658 | if(xil.lt.xiu) then | |
35659 | ||
35660 | CALL PHO_GAUSET(xil,xiu,Ngau2,xpos2,xwgh2) | |
35661 | ||
35662 | do i2=1,Ngau2 | |
35663 | ||
35664 | xms_2 = exp(xpos2(i2))*SS | |
35665 | CSdiff = CSdiff | |
35666 | & + 1.d0/((xms_1*xms_2)**delta*log(SS/(xms_1*xms_2))) | |
35667 | & *xwgh1(i1)*xwgh2(i2) | |
35668 | ||
35669 | enddo | |
35670 | ||
35671 | endif | |
35672 | ||
35673 | enddo | |
35674 | ||
35675 | sig_dd = CSdiff*fac*GEV2MB | |
35676 | ||
35677 | 3000 continue | |
35678 | ||
35679 | ELSE | |
35680 | ||
35681 | WRITE(LO,'(1x,2a,2I8)') 'PHO_CSDIFF: ', | |
35682 | & 'invalid particle combination (Id1/2)',Id1,Id2 | |
35683 | ||
35684 | ENDIF | |
35685 | ||
35686 | END | |
35687 | ||
35688 | *$ CREATE PHO_ALLM97.FOR | |
35689 | *COPY PHO_ALLM97 | |
35690 | CDECK ID>, PHO_ALLM97 | |
35691 | DOUBLE PRECISION FUNCTION PHO_ALLM97(Q2,W) | |
35692 | C********************************************************************** | |
35693 | C | |
35694 | C ALLM97 parametrization for gamma*-p cross section | |
35695 | C (for F2 see comments, code adapted from V. Shekelyan, H1) | |
35696 | C | |
35697 | C********************************************************************** | |
35698 | IMPLICIT NONE | |
35699 | SAVE | |
35700 | ||
35701 | C input/output channels | |
35702 | INTEGER LI,LO | |
35703 | COMMON /POINOU/ LI,LO | |
35704 | ||
35705 | DOUBLE PRECISION Q2,W | |
35706 | DOUBLE PRECISION M02,M12,LAM2,M22 | |
35707 | DOUBLE PRECISION S11,S12,S13,A11,A12,A13,B11,B12,B13 | |
35708 | DOUBLE PRECISION S21,S22,S23,A21,A22,A23,B21,B22,B23 | |
35709 | DOUBLE PRECISION ALFA,XMP2,W2,Q02,S,T,T0,Z,CIN, | |
35710 | & AP,BP,AR,BR,XP,XR,SR,SP,F2P,F2R | |
35711 | DATA ALFA,XMP2 /112.2D0 , .8802D0 / | |
35712 | ||
35713 | W2=W*W | |
35714 | PHO_ALLM97 = 0.D0 | |
35715 | ||
35716 | C pomeron | |
35717 | S11 = 0.28067D0 | |
35718 | S12 = 0.22291D0 | |
35719 | S13 = 2.1979D0 | |
35720 | A11 = -0.0808D0 | |
35721 | A12 = -0.44812D0 | |
35722 | A13 = 1.1709D0 | |
35723 | B11 = 0.60243D0 | |
35724 | B12 = 1.3754D0 | |
35725 | B13 = 1.8439D0 | |
35726 | M12 = 49.457D0 | |
35727 | ||
35728 | C reggeon | |
35729 | S21 = 0.80107D0 | |
35730 | S22 = 0.97307D0 | |
35731 | S23 = 3.4942D0 | |
35732 | A21 = 0.58400D0 | |
35733 | A22 = 0.37888D0 | |
35734 | A23 = 2.6063D0 | |
35735 | B21 = 0.10711D0 | |
35736 | B22 = 1.9386D0 | |
35737 | B23 = 0.49338D0 | |
35738 | M22 = 0.15052D0 | |
35739 | C | |
35740 | M02 = 0.31985D0 | |
35741 | LAM2 = 0.065270D0 | |
35742 | Q02 = 0.46017D0 +LAM2 | |
35743 | ||
35744 | C | |
35745 | S=0. | |
35746 | T=LOG((Q2+Q02)/LAM2) | |
35747 | T0=LOG(Q02/LAM2) | |
35748 | IF(Q2.GT.0.D0) S=LOG(T/T0) | |
35749 | Z=1.D0 | |
35750 | ||
35751 | IF(Q2.GT.0.D0) Z=(W2-XMP2)/(Q2+W2-XMP2) | |
35752 | ||
35753 | IF(S.LT.0.01D0) THEN | |
35754 | ||
35755 | C pomeron part | |
35756 | ||
35757 | XP=1.D0 /(1.D0 +(W2-XMP2)/(Q2+M12)) | |
35758 | ||
35759 | AP=A11 | |
35760 | BP=B11**2 | |
35761 | ||
35762 | SP=S11 | |
35763 | F2P=SP*XP**AP*Z**BP | |
35764 | ||
35765 | C reggeon part | |
35766 | ||
35767 | XR=1.D0 /(1.D0 +(W2-XMP2)/(Q2+M22)) | |
35768 | ||
35769 | AR=A21 | |
35770 | BR=B21**2 | |
35771 | ||
35772 | SR=S21 | |
35773 | F2R=SR*XR**AR*Z**BR | |
35774 | ||
35775 | ELSE | |
35776 | ||
35777 | C pomeron part | |
35778 | ||
35779 | XP=1.D0 /(1.D0 +(W2-XMP2)/(Q2+M12)) | |
35780 | ||
35781 | AP=A11+(A11-A12)*(1.D0 /(1.D0 +S**A13)-1.D0 ) | |
35782 | ||
35783 | BP=B11**2+B12**2*S**B13 | |
35784 | ||
35785 | SP=S11+(S11-S12)*(1.D0 /(1.D0 +S**S13)-1.D0 ) | |
35786 | ||
35787 | F2P=SP*XP**AP*Z**BP | |
35788 | ||
35789 | C reggeon part | |
35790 | ||
35791 | XR=1.D0 /(1.D0 +(W2-XMP2)/(Q2+M22)) | |
35792 | ||
35793 | AR=A21+A22*S**A23 | |
35794 | BR=B21**2+B22**2*S**B23 | |
35795 | ||
35796 | SR=S21+S22*S**S23 | |
35797 | F2R=SR*XR**AR*Z**BR | |
35798 | ||
35799 | ENDIF | |
35800 | ||
35801 | * F2 = (F2P+F2R)*Q2/(Q2+M02) | |
35802 | ||
35803 | CIN=ALFA/(Q2+M02)*(1.D0 +4.D0*XMP2*Q2/(Q2+W2-XMP2)**2)/Z | |
35804 | PHO_ALLM97 = CIN*(F2P+F2R) | |
35805 | ||
35806 | END | |
35807 | ||
35808 | *$ CREATE PHO_DOR98LO.FOR | |
35809 | *COPY PHO_DOR98LO | |
35810 | CDECK ID>, PHO_DOR98LO | |
35811 | SUBROUTINE PHO_DOR98LO (Xinp, Q2inp, UV, DV, US, DS, SS, GL) | |
35812 | C*********************************************************************** | |
35813 | C | |
35814 | C GRV98 parton densities, leading order set | |
35815 | C | |
35816 | C For a detailed explanation see | |
35817 | C M. Glueck, E. Reya, A. Vogt : | |
35818 | C hep-ph/9806404 = DO-TH 98/07 = WUE-ITP-98-019 | |
35819 | C (To appear in Eur. Phys. J. C) | |
35820 | C | |
35821 | C interpolation routine based on the original GRV98PA routine, | |
35822 | C adapted to define interpolation table as DATA statements | |
35823 | C | |
35824 | C (R.Engel, 09/98) | |
35825 | C | |
35826 | C | |
35827 | C INPUT: X = Bjorken-x (between 1.E-9 and 1.) | |
35828 | C Q2 = scale in GeV**2 (between 0.8 and 1.E6) | |
35829 | C | |
35830 | C OUTPUT: UV = u - u(bar), DV = d - d(bar), US = u(bar), | |
35831 | C DS = d(bar), SS = s = s(bar), GL = gluon. | |
35832 | C Always x times the distribution is returned. | |
35833 | C | |
35834 | C******************************************************i**************** | |
35835 | IMPLICIT DOUBLE PRECISION (A-H, O-Z) | |
35836 | SAVE | |
35837 | ||
35838 | C input/output channels | |
35839 | INTEGER LI,LO | |
35840 | COMMON /POINOU/ LI,LO | |
35841 | ||
35842 | PARAMETER (NPART=6, NX=68, NQ=27, NARG=2) | |
35843 | DIMENSION XUVF(NX,NQ), XDVF(NX,NQ), XDEF(NX,NQ), XUDF(NX,NQ), | |
35844 | 1 XSF(NX,NQ), XGF(NX,NQ), | |
35845 | 2 XT(NARG), NA(NARG), ARRF(NX+NQ) | |
35846 | ||
35847 | DIMENSION XUVF_L(NX*NQ), XDVF_L(NX*NQ), XDEF_L(NX*NQ), | |
35848 | & XUDF_L(NX*NQ), XSF_L(NX*NQ), XGF_L(NX*NQ) | |
35849 | ||
35850 | EQUIVALENCE (XUVF(1,1),XUVF_L(1)) | |
35851 | EQUIVALENCE (XDVF(1,1),XDVF_L(1)) | |
35852 | EQUIVALENCE (XDEF(1,1),XDEF_L(1)) | |
35853 | EQUIVALENCE (XUDF(1,1),XUDF_L(1)) | |
35854 | EQUIVALENCE (XSF(1,1),XSF_L(1)) | |
35855 | EQUIVALENCE (XGF(1,1),XGF_L(1)) | |
35856 | ||
35857 | DATA (ARRF(K),K= 1, 95) / | |
35858 | & -2.0723E+01,-2.0135E+01,-1.9560E+01,-1.8983E+01,-1.8421E+01, | |
35859 | & -1.7833E+01,-1.7258E+01,-1.6680E+01,-1.6118E+01,-1.5530E+01, | |
35860 | & -1.4955E+01,-1.4378E+01,-1.3816E+01,-1.3479E+01,-1.3122E+01, | |
35861 | & -1.2717E+01,-1.2311E+01,-1.1913E+01,-1.1513E+01,-1.1176E+01, | |
35862 | & -1.0820E+01,-1.0414E+01,-1.0009E+01,-9.6108E+00,-9.2103E+00, | |
35863 | & -8.8739E+00,-8.5172E+00,-8.1117E+00,-7.7063E+00,-7.3082E+00, | |
35864 | & -6.9078E+00,-6.5713E+00,-6.2146E+00,-5.8091E+00,-5.4037E+00, | |
35865 | & -5.0056E+00,-4.6052E+00,-4.2687E+00,-3.9120E+00,-3.5066E+00, | |
35866 | & -3.1011E+00,-2.8134E+00,-2.5257E+00,-2.3026E+00,-2.0794E+00, | |
35867 | & -1.8971E+00,-1.7430E+00,-1.6094E+00,-1.4917E+00,-1.3863E+00, | |
35868 | & -1.2910E+00,-1.2040E+00,-1.1239E+00,-1.0498E+00,-9.8083E-01, | |
35869 | & -9.1629E-01,-7.9851E-01,-6.9315E-01,-5.9784E-01,-5.1083E-01, | |
35870 | & -4.3078E-01,-3.5667E-01,-2.8768E-01,-2.2314E-01,-1.6252E-01, | |
35871 | & -1.0536E-01,-5.1293E-02, 0.0000E+00,-2.2314E-01, 0.0000E+00, | |
35872 | & 2.6236E-01, 5.8779E-01, 9.9325E-01, 1.3863E+00, 1.8563E+00, | |
35873 | & 2.3026E+00, 2.7726E+00, 3.2189E+00, 3.6889E+00, 4.1589E+00, | |
35874 | & 4.6052E+00, 5.1930E+00, 5.7683E+00, 6.3456E+00, 6.9078E+00, | |
35875 | & 7.4955E+00, 8.0709E+00, 8.6482E+00, 9.2103E+00, 9.9988E+00, | |
35876 | & 1.0736E+01, 1.1513E+01, 1.2301E+01, 1.3039E+01, 1.3816E+01/ | |
35877 | DATA (XUVF_L(K),K= 1, 114) / | |
35878 | &2.3186E+00,2.2915E+00,2.2645E+00,2.2385E+00,2.2140E+00,2.1876E+00, | |
35879 | &2.1623E+00,2.1366E+00,2.1121E+00,2.0862E+00,2.0612E+00,2.0358E+00, | |
35880 | &2.0110E+00,1.9963E+00,1.9806E+00,1.9624E+00,1.9446E+00,1.9263E+00, | |
35881 | &1.9072E+00,1.8904E+00,1.8724E+00,1.8515E+00,1.8294E+00,1.8085E+00, | |
35882 | &1.7865E+00,1.7680E+00,1.7483E+00,1.7249E+00,1.6993E+00,1.6715E+00, | |
35883 | &1.6385E+00,1.6141E+00,1.5884E+00,1.5597E+00,1.5337E+00,1.5121E+00, | |
35884 | &1.4985E+00,1.4980E+00,1.5116E+00,1.5555E+00,1.6432E+00,1.7434E+00, | |
35885 | &1.8861E+00,2.0327E+00,2.2174E+00,2.4015E+00,2.5849E+00,2.7671E+00, | |
35886 | &2.9488E+00,3.1308E+00,3.3142E+00,3.4998E+00,3.6885E+00,3.8826E+00, | |
35887 | &4.0815E+00,4.2069E+00,4.5481E+00,4.8830E+00,5.2116E+00,5.5351E+00, | |
35888 | &5.8553E+00,6.1665E+00,6.4745E+00,6.7767E+00,7.0735E+00,7.3628E+00, | |
35889 | &7.6283E+00,0.0000E+00,2.3948E+00,2.3665E+00,2.3388E+00,2.3126E+00, | |
35890 | &2.2860E+00,2.2592E+00,2.2327E+00,2.2065E+00,2.1810E+00,2.1541E+00, | |
35891 | &2.1284E+00,2.1020E+00,2.0760E+00,2.0605E+00,2.0443E+00,2.0259E+00, | |
35892 | &2.0068E+00,1.9873E+00,1.9676E+00,1.9500E+00,1.9312E+00,1.9081E+00, | |
35893 | &1.8860E+00,1.8635E+00,1.8406E+00,1.8221E+00,1.8007E+00,1.7764E+00, | |
35894 | &1.7489E+00,1.7195E+00,1.6855E+00,1.6600E+00,1.6332E+00,1.6031E+00, | |
35895 | &1.5760E+00,1.5532E+00,1.5397E+00,1.5376E+00,1.5507E+00,1.5929E+00, | |
35896 | &1.6784E+00,1.7759E+00,1.9129E+00,2.0531E+00,2.2292E+00,2.4032E+00/ | |
35897 | DATA (XUVF_L(K),K= 115, 228) / | |
35898 | &2.5752E+00,2.7449E+00,2.9135E+00,3.0810E+00,3.2491E+00,3.4183E+00, | |
35899 | &3.5898E+00,3.7650E+00,3.9437E+00,4.0443E+00,4.3402E+00,4.6262E+00, | |
35900 | &4.9009E+00,5.1640E+00,5.4156E+00,5.6530E+00,5.8759E+00,6.0779E+00, | |
35901 | &6.2540E+00,6.3836E+00,6.4062E+00,0.0000E+00,2.4808E+00,2.4513E+00, | |
35902 | &2.4236E+00,2.3948E+00,2.3680E+00,2.3397E+00,2.3127E+00,2.2853E+00, | |
35903 | &2.2585E+00,2.2307E+00,2.2026E+00,2.1762E+00,2.1490E+00,2.1332E+00, | |
35904 | &2.1164E+00,2.0964E+00,2.0766E+00,2.0565E+00,2.0353E+00,2.0171E+00, | |
35905 | &1.9969E+00,1.9738E+00,1.9501E+00,1.9258E+00,1.9026E+00,1.8821E+00, | |
35906 | &1.8594E+00,1.8330E+00,1.8046E+00,1.7734E+00,1.7378E+00,1.7112E+00, | |
35907 | &1.6829E+00,1.6514E+00,1.6228E+00,1.5994E+00,1.5840E+00,1.5808E+00, | |
35908 | &1.5927E+00,1.6334E+00,1.7157E+00,1.8093E+00,1.9406E+00,2.0735E+00, | |
35909 | &2.2394E+00,2.4019E+00,2.5615E+00,2.7178E+00,2.8718E+00,3.0246E+00, | |
35910 | &3.1766E+00,3.3284E+00,3.4820E+00,3.6370E+00,3.7952E+00,3.8716E+00, | |
35911 | &4.1225E+00,4.3580E+00,4.5798E+00,4.7847E+00,4.9730E+00,5.1395E+00, | |
35912 | &5.2832E+00,5.3945E+00,5.4634E+00,5.4612E+00,5.2940E+00,0.0000E+00, | |
35913 | &2.5823E+00,2.5527E+00,2.5226E+00,2.4928E+00,2.4650E+00,2.4358E+00, | |
35914 | &2.4071E+00,2.3783E+00,2.3505E+00,2.3212E+00,2.2928E+00,2.2636E+00, | |
35915 | &2.2360E+00,2.2185E+00,2.2005E+00,2.1801E+00,2.1591E+00,2.1376E+00, | |
35916 | &2.1153E+00,2.0960E+00,2.0747E+00,2.0505E+00,2.0247E+00,1.9991E+00/ | |
35917 | DATA (XUVF_L(K),K= 229, 342) / | |
35918 | &1.9746E+00,1.9523E+00,1.9287E+00,1.9000E+00,1.8693E+00,1.8361E+00, | |
35919 | &1.7994E+00,1.7711E+00,1.7409E+00,1.7076E+00,1.6772E+00,1.6517E+00, | |
35920 | &1.6345E+00,1.6302E+00,1.6408E+00,1.6789E+00,1.7574E+00,1.8457E+00, | |
35921 | &1.9692E+00,2.0939E+00,2.2474E+00,2.3969E+00,2.5419E+00,2.6837E+00, | |
35922 | &2.8216E+00,2.9573E+00,3.0915E+00,3.2246E+00,3.3583E+00,3.4917E+00, | |
35923 | &3.6273E+00,3.6791E+00,3.8823E+00,4.0673E+00,4.2350E+00,4.3813E+00, | |
35924 | &4.5072E+00,4.6083E+00,4.6757E+00,4.7055E+00,4.6825E+00,4.5674E+00, | |
35925 | &4.2566E+00,0.0000E+00,2.7025E+00,2.6705E+00,2.6393E+00,2.6093E+00, | |
35926 | &2.5790E+00,2.5484E+00,2.5184E+00,2.4880E+00,2.4590E+00,2.4277E+00, | |
35927 | &2.3971E+00,2.3669E+00,2.3380E+00,2.3200E+00,2.3002E+00,2.2782E+00, | |
35928 | &2.2557E+00,2.2331E+00,2.2092E+00,2.1887E+00,2.1660E+00,2.1400E+00, | |
35929 | &2.1126E+00,2.0859E+00,2.0586E+00,2.0351E+00,2.0094E+00,1.9786E+00, | |
35930 | &1.9453E+00,1.9096E+00,1.8707E+00,1.8406E+00,1.8084E+00,1.7728E+00, | |
35931 | &1.7392E+00,1.7128E+00,1.6933E+00,1.6875E+00,1.6949E+00,1.7295E+00, | |
35932 | &1.8023E+00,1.8845E+00,1.9991E+00,2.1134E+00,2.2525E+00,2.3868E+00, | |
35933 | &2.5160E+00,2.6405E+00,2.7609E+00,2.8781E+00,2.9929E+00,3.1059E+00, | |
35934 | &3.2180E+00,3.3292E+00,3.4407E+00,3.4675E+00,3.6225E+00,3.7573E+00, | |
35935 | &3.8710E+00,3.9617E+00,4.0270E+00,4.0642E+00,4.0675E+00,4.0263E+00, | |
35936 | &3.9240E+00,3.7262E+00,3.3217E+00,0.0000E+00,2.8135E+00,2.7813E+00/ | |
35937 | DATA (XUVF_L(K),K= 343, 456) / | |
35938 | &2.7489E+00,2.7166E+00,2.6850E+00,2.6527E+00,2.6212E+00,2.5898E+00, | |
35939 | &2.5592E+00,2.5267E+00,2.4943E+00,2.4636E+00,2.4320E+00,2.4129E+00, | |
35940 | &2.3929E+00,2.3695E+00,2.3453E+00,2.3211E+00,2.2959E+00,2.2740E+00, | |
35941 | &2.2496E+00,2.2221E+00,2.1931E+00,2.1653E+00,2.1356E+00,2.1112E+00, | |
35942 | &2.0830E+00,2.0503E+00,2.0147E+00,1.9766E+00,1.9361E+00,1.9037E+00, | |
35943 | &1.8696E+00,1.8318E+00,1.7966E+00,1.7677E+00,1.7459E+00,1.7378E+00, | |
35944 | &1.7430E+00,1.7738E+00,1.8407E+00,1.9169E+00,2.0223E+00,2.1273E+00, | |
35945 | &2.2537E+00,2.3742E+00,2.4892E+00,2.5990E+00,2.7043E+00,2.8056E+00, | |
35946 | &2.9038E+00,3.0000E+00,3.0936E+00,3.1864E+00,3.2782E+00,3.2867E+00, | |
35947 | &3.4021E+00,3.4971E+00,3.5691E+00,3.6188E+00,3.6422E+00,3.6335E+00, | |
35948 | &3.5908E+00,3.5036E+00,3.3552E+00,3.1085E+00,2.6634E+00,0.0000E+00, | |
35949 | &2.9406E+00,2.9062E+00,2.8726E+00,2.8385E+00,2.8060E+00,2.7720E+00, | |
35950 | &2.7392E+00,2.7058E+00,2.6734E+00,2.6399E+00,2.6057E+00,2.5722E+00, | |
35951 | &2.5390E+00,2.5194E+00,2.4975E+00,2.4728E+00,2.4471E+00,2.4216E+00, | |
35952 | &2.3945E+00,2.3712E+00,2.3458E+00,2.3152E+00,2.2856E+00,2.2545E+00, | |
35953 | &2.2237E+00,2.1966E+00,2.1672E+00,2.1312E+00,2.0926E+00,2.0521E+00, | |
35954 | &2.0093E+00,1.9748E+00,1.9384E+00,1.8975E+00,1.8601E+00,1.8275E+00, | |
35955 | &1.8036E+00,1.7924E+00,1.7948E+00,1.8206E+00,1.8808E+00,1.9499E+00, | |
35956 | &2.0450E+00,2.1390E+00,2.2512E+00,2.3570E+00,2.4564E+00,2.5501E+00/ | |
35957 | DATA (XUVF_L(K),K= 457, 570) / | |
35958 | &2.6391E+00,2.7240E+00,2.8053E+00,2.8834E+00,2.9590E+00,3.0326E+00, | |
35959 | &3.1042E+00,3.0942E+00,3.1727E+00,3.2289E+00,3.2628E+00,3.2739E+00, | |
35960 | &3.2574E+00,3.2103E+00,3.1297E+00,3.0047E+00,2.8211E+00,2.5467E+00, | |
35961 | &2.0897E+00,0.0000E+00,3.0557E+00,3.0193E+00,2.9840E+00,2.9497E+00, | |
35962 | &2.9150E+00,2.8801E+00,2.8454E+00,2.8109E+00,2.7771E+00,2.7412E+00, | |
35963 | &2.7065E+00,2.6716E+00,2.6360E+00,2.6149E+00,2.5923E+00,2.5663E+00, | |
35964 | &2.5395E+00,2.5120E+00,2.4834E+00,2.4589E+00,2.4330E+00,2.4011E+00, | |
35965 | &2.3676E+00,2.3363E+00,2.3027E+00,2.2736E+00,2.2422E+00,2.2040E+00, | |
35966 | &2.1629E+00,2.1194E+00,2.0750E+00,2.0384E+00,1.9996E+00,1.9565E+00, | |
35967 | &1.9160E+00,1.8811E+00,1.8541E+00,1.8409E+00,1.8399E+00,1.8611E+00, | |
35968 | &1.9143E+00,1.9764E+00,2.0622E+00,2.1459E+00,2.2457E+00,2.3385E+00, | |
35969 | &2.4249E+00,2.5051E+00,2.5806E+00,2.6515E+00,2.7182E+00,2.7823E+00, | |
35970 | &2.8427E+00,2.9008E+00,2.9564E+00,2.9332E+00,2.9828E+00,3.0094E+00, | |
35971 | &3.0142E+00,2.9955E+00,2.9537E+00,2.8796E+00,2.7735E+00,2.6260E+00, | |
35972 | &2.4242E+00,2.1388E+00,1.6900E+00,0.0000E+00,3.1718E+00,3.1348E+00, | |
35973 | &3.0971E+00,3.0610E+00,3.0260E+00,2.9896E+00,2.9533E+00,2.9173E+00, | |
35974 | &2.8818E+00,2.8449E+00,2.8072E+00,2.7709E+00,2.7340E+00,2.7121E+00, | |
35975 | &2.6877E+00,2.6605E+00,2.6319E+00,2.6032E+00,2.5732E+00,2.5471E+00, | |
35976 | &2.5180E+00,2.4851E+00,2.4511E+00,2.4170E+00,2.3817E+00,2.3505E+00/ | |
35977 | DATA (XUVF_L(K),K= 571, 684) / | |
35978 | &2.3172E+00,2.2762E+00,2.2328E+00,2.1868E+00,2.1400E+00,2.1012E+00, | |
35979 | &2.0601E+00,2.0136E+00,1.9704E+00,1.9335E+00,1.9035E+00,1.8868E+00, | |
35980 | &1.8827E+00,1.8990E+00,1.9452E+00,2.0005E+00,2.0763E+00,2.1507E+00, | |
35981 | &2.2377E+00,2.3179E+00,2.3917E+00,2.4592E+00,2.5218E+00,2.5799E+00, | |
35982 | &2.6336E+00,2.6843E+00,2.7314E+00,2.7753E+00,2.8166E+00,2.7824E+00, | |
35983 | &2.8054E+00,2.8081E+00,2.7893E+00,2.7474E+00,2.6818E+00,2.5888E+00, | |
35984 | &2.4646E+00,2.3032E+00,2.0902E+00,1.8025E+00,1.3740E+00,0.0000E+00, | |
35985 | &3.2793E+00,3.2385E+00,3.2014E+00,3.1643E+00,3.1270E+00,3.0888E+00, | |
35986 | &3.0517E+00,3.0141E+00,2.9773E+00,2.9392E+00,2.9009E+00,2.8610E+00, | |
35987 | &2.8230E+00,2.8000E+00,2.7754E+00,2.7459E+00,2.7163E+00,2.6858E+00, | |
35988 | &2.6545E+00,2.6270E+00,2.5962E+00,2.5617E+00,2.5271E+00,2.4903E+00, | |
35989 | &2.4527E+00,2.4207E+00,2.3851E+00,2.3421E+00,2.2960E+00,2.2476E+00, | |
35990 | &2.1987E+00,2.1578E+00,2.1146E+00,2.0670E+00,2.0202E+00,1.9796E+00, | |
35991 | &1.9468E+00,1.9282E+00,1.9203E+00,1.9319E+00,1.9712E+00,2.0197E+00, | |
35992 | &2.0872E+00,2.1524E+00,2.2288E+00,2.2981E+00,2.3606E+00,2.4177E+00, | |
35993 | &2.4692E+00,2.5159E+00,2.5591E+00,2.5981E+00,2.6339E+00,2.6669E+00, | |
35994 | &2.6962E+00,2.6528E+00,2.6566E+00,2.6395E+00,2.6028E+00,2.5437E+00, | |
35995 | &2.4622E+00,2.3555E+00,2.2200E+00,2.0488E+00,1.8335E+00,1.5506E+00, | |
35996 | &1.1442E+00,0.0000E+00,3.3868E+00,3.3470E+00,3.3075E+00,3.2689E+00/ | |
35997 | DATA (XUVF_L(K),K= 685, 798) / | |
35998 | &3.2300E+00,3.1909E+00,3.1517E+00,3.1129E+00,3.0747E+00,3.0335E+00, | |
35999 | &2.9946E+00,2.9537E+00,2.9140E+00,2.8896E+00,2.8638E+00,2.8337E+00, | |
36000 | &2.8021E+00,2.7705E+00,2.7373E+00,2.7075E+00,2.6767E+00,2.6403E+00, | |
36001 | &2.6031E+00,2.5649E+00,2.5258E+00,2.4917E+00,2.4537E+00,2.4080E+00, | |
36002 | &2.3597E+00,2.3091E+00,2.2580E+00,2.2150E+00,2.1692E+00,2.1186E+00, | |
36003 | &2.0701E+00,2.0257E+00,1.9901E+00,1.9679E+00,1.9571E+00,1.9629E+00, | |
36004 | &1.9955E+00,2.0378E+00,2.0963E+00,2.1529E+00,2.2178E+00,2.2766E+00, | |
36005 | &2.3287E+00,2.3749E+00,2.4162E+00,2.4529E+00,2.4850E+00,2.5140E+00, | |
36006 | &2.5392E+00,2.5617E+00,2.5798E+00,2.5298E+00,2.5151E+00,2.4811E+00, | |
36007 | &2.4282E+00,2.3561E+00,2.2611E+00,2.1439E+00,2.0005E+00,1.8252E+00, | |
36008 | &1.6091E+00,1.3345E+00,9.5375E-01,0.0000E+00,3.4912E+00,3.4507E+00, | |
36009 | &3.4100E+00,3.3696E+00,3.3310E+00,3.2893E+00,3.2496E+00,3.2088E+00, | |
36010 | &3.1686E+00,3.1278E+00,3.0865E+00,3.0438E+00,3.0020E+00,2.9766E+00, | |
36011 | &2.9494E+00,2.9180E+00,2.8850E+00,2.8520E+00,2.8174E+00,2.7877E+00, | |
36012 | &2.7550E+00,2.7169E+00,2.6762E+00,2.6369E+00,2.5958E+00,2.5594E+00, | |
36013 | &2.5195E+00,2.4721E+00,2.4211E+00,2.3680E+00,2.3145E+00,2.2695E+00, | |
36014 | &2.2214E+00,2.1684E+00,2.1154E+00,2.0706E+00,2.0303E+00,2.0058E+00, | |
36015 | &1.9909E+00,1.9920E+00,2.0177E+00,2.0531E+00,2.1031E+00,2.1511E+00, | |
36016 | &2.2060E+00,2.2548E+00,2.2972E+00,2.3339E+00,2.3655E+00,2.3927E+00/ | |
36017 | DATA (XUVF_L(K),K= 799, 912) / | |
36018 | &2.4159E+00,2.4357E+00,2.4520E+00,2.4644E+00,2.4735E+00,2.4171E+00, | |
36019 | &2.3878E+00,2.3397E+00,2.2743E+00,2.1907E+00,2.0861E+00,1.9611E+00, | |
36020 | &1.8128E+00,1.6351E+00,1.4227E+00,1.1584E+00,8.0371E-01,0.0000E+00, | |
36021 | &3.5892E+00,3.5473E+00,3.5055E+00,3.4637E+00,3.4230E+00,3.3809E+00, | |
36022 | &3.3396E+00,3.2976E+00,3.2571E+00,3.2126E+00,3.1696E+00,3.1272E+00, | |
36023 | &3.0840E+00,3.0569E+00,3.0286E+00,2.9959E+00,2.9619E+00,2.9273E+00, | |
36024 | &2.8910E+00,2.8598E+00,2.8266E+00,2.7863E+00,2.7448E+00,2.7029E+00, | |
36025 | &2.6598E+00,2.6219E+00,2.5804E+00,2.5305E+00,2.4773E+00,2.4214E+00, | |
36026 | &2.3662E+00,2.3191E+00,2.2698E+00,2.2126E+00,2.1577E+00,2.1092E+00, | |
36027 | &2.0674E+00,2.0393E+00,2.0210E+00,2.0173E+00,2.0367E+00,2.0654E+00, | |
36028 | &2.1076E+00,2.1485E+00,2.1942E+00,2.2338E+00,2.2678E+00,2.2959E+00, | |
36029 | &2.3193E+00,2.3386E+00,2.3539E+00,2.3660E+00,2.3738E+00,2.3789E+00, | |
36030 | &2.3799E+00,2.3197E+00,2.2776E+00,2.2186E+00,2.1426E+00,2.0495E+00, | |
36031 | &1.9397E+00,1.8097E+00,1.6583E+00,1.4814E+00,1.2736E+00,1.0200E+00, | |
36032 | &6.8880E-01,0.0000E+00,3.7157E+00,3.6699E+00,3.6275E+00,3.5842E+00, | |
36033 | &3.5420E+00,3.4972E+00,3.4542E+00,3.4107E+00,3.3678E+00,3.3234E+00, | |
36034 | &3.2774E+00,3.2332E+00,3.1870E+00,3.1600E+00,3.1297E+00,3.0952E+00, | |
36035 | &3.0595E+00,3.0231E+00,2.9850E+00,2.9534E+00,2.9160E+00,2.8740E+00, | |
36036 | &2.8312E+00,2.7872E+00,2.7408E+00,2.7014E+00,2.6568E+00,2.6045E+00/ | |
36037 | DATA (XUVF_L(K),K= 913, 1026) / | |
36038 | &2.5481E+00,2.4895E+00,2.4315E+00,2.3817E+00,2.3283E+00,2.2697E+00, | |
36039 | &2.2106E+00,2.1591E+00,2.1128E+00,2.0807E+00,2.0578E+00,2.0477E+00, | |
36040 | &2.0583E+00,2.0796E+00,2.1122E+00,2.1433E+00,2.1777E+00,2.2069E+00, | |
36041 | &2.2299E+00,2.2483E+00,2.2618E+00,2.2718E+00,2.2778E+00,2.2803E+00, | |
36042 | &2.2797E+00,2.2749E+00,2.2668E+00,2.2019E+00,2.1468E+00,2.0761E+00, | |
36043 | &1.9902E+00,1.8883E+00,1.7711E+00,1.6370E+00,1.4847E+00,1.3103E+00, | |
36044 | &1.1091E+00,8.7047E-01,5.6856E-01,0.0000E+00,3.8327E+00,3.7877E+00, | |
36045 | &3.7424E+00,3.6981E+00,3.6540E+00,3.6083E+00,3.5637E+00,3.5184E+00, | |
36046 | &3.4753E+00,3.4271E+00,3.3800E+00,3.3325E+00,3.2860E+00,3.2564E+00, | |
36047 | &3.2258E+00,3.1893E+00,3.1519E+00,3.1135E+00,3.0738E+00,3.0389E+00, | |
36048 | &3.0010E+00,2.9580E+00,2.9118E+00,2.8654E+00,2.8178E+00,2.7758E+00, | |
36049 | &2.7289E+00,2.6738E+00,2.6146E+00,2.5530E+00,2.4924E+00,2.4399E+00, | |
36050 | &2.3845E+00,2.3213E+00,2.2605E+00,2.2040E+00,2.1540E+00,2.1186E+00, | |
36051 | &2.0908E+00,2.0749E+00,2.0772E+00,2.0914E+00,2.1145E+00,2.1368E+00, | |
36052 | &2.1613E+00,2.1804E+00,2.1941E+00,2.2037E+00,2.2088E+00,2.2101E+00, | |
36053 | &2.2083E+00,2.2031E+00,2.1942E+00,2.1826E+00,2.1665E+00,2.0987E+00, | |
36054 | &2.0321E+00,1.9516E+00,1.8571E+00,1.7497E+00,1.6281E+00,1.4923E+00, | |
36055 | &1.3406E+00,1.1697E+00,9.7635E-01,7.5209E-01,4.7638E-01,0.0000E+00, | |
36056 | &3.9497E+00,3.9009E+00,3.8555E+00,3.8080E+00,3.7630E+00,3.7163E+00/ | |
36057 | DATA (XUVF_L(K),K= 1027, 1140) / | |
36058 | &3.6699E+00,3.6231E+00,3.5765E+00,3.5285E+00,3.4807E+00,3.4305E+00, | |
36059 | &3.3810E+00,3.3511E+00,3.3185E+00,3.2805E+00,3.2414E+00,3.2016E+00, | |
36060 | &3.1598E+00,3.1244E+00,3.0837E+00,3.0383E+00,2.9908E+00,2.9424E+00, | |
36061 | &2.8919E+00,2.8477E+00,2.7990E+00,2.7403E+00,2.6784E+00,2.6142E+00, | |
36062 | &2.5507E+00,2.4960E+00,2.4362E+00,2.3710E+00,2.3058E+00,2.2463E+00, | |
36063 | &2.1931E+00,2.1539E+00,2.1216E+00,2.0996E+00,2.0940E+00,2.1012E+00, | |
36064 | &2.1154E+00,2.1294E+00,2.1444E+00,2.1543E+00,2.1597E+00,2.1610E+00, | |
36065 | &2.1585E+00,2.1523E+00,2.1432E+00,2.1307E+00,2.1155E+00,2.0964E+00, | |
36066 | &2.0742E+00,2.0035E+00,1.9273E+00,1.8396E+00,1.7387E+00,1.6273E+00, | |
36067 | &1.5032E+00,1.3665E+00,1.2164E+00,1.0501E+00,8.6515E-01,6.5470E-01, | |
36068 | &4.0284E-01,0.0000E+00,4.0572E+00,4.0093E+00,3.9616E+00,3.9140E+00, | |
36069 | &3.8670E+00,3.8185E+00,3.7706E+00,3.7224E+00,3.6746E+00,3.6251E+00, | |
36070 | &3.5744E+00,3.5233E+00,3.4720E+00,3.4406E+00,3.4062E+00,3.3671E+00, | |
36071 | &3.3263E+00,3.2847E+00,3.2414E+00,3.2046E+00,3.1620E+00,3.1150E+00, | |
36072 | &3.0653E+00,3.0145E+00,2.9619E+00,2.9153E+00,2.8641E+00,2.8032E+00, | |
36073 | &2.7388E+00,2.6715E+00,2.6056E+00,2.5481E+00,2.4880E+00,2.4171E+00, | |
36074 | &2.3496E+00,2.2862E+00,2.2282E+00,2.1865E+00,2.1502E+00,2.1217E+00, | |
36075 | &2.1086E+00,2.1086E+00,2.1149E+00,2.1216E+00,2.1275E+00,2.1295E+00, | |
36076 | &2.1273E+00,2.1212E+00,2.1119E+00,2.0992E+00,2.0837E+00,2.0653E+00/ | |
36077 | DATA (XUVF_L(K),K= 1141, 1254) / | |
36078 | &2.0442E+00,2.0194E+00,1.9912E+00,1.9193E+00,1.8359E+00,1.7412E+00, | |
36079 | &1.6366E+00,1.5214E+00,1.3956E+00,1.2594E+00,1.1115E+00,9.5033E-01, | |
36080 | &7.7356E-01,5.7585E-01,3.4506E-01,0.0000E+00,4.1710E+00,4.1201E+00, | |
36081 | &4.0712E+00,4.0213E+00,3.9730E+00,3.9228E+00,3.8734E+00,3.8233E+00, | |
36082 | &3.7726E+00,3.7217E+00,3.6699E+00,3.6160E+00,3.5640E+00,3.5311E+00, | |
36083 | &3.4960E+00,3.4549E+00,3.4121E+00,3.3689E+00,3.3237E+00,3.2848E+00, | |
36084 | &3.2425E+00,3.1917E+00,3.1399E+00,3.0866E+00,3.0319E+00,2.9838E+00, | |
36085 | &2.9306E+00,2.8668E+00,2.7992E+00,2.7291E+00,2.6605E+00,2.6007E+00, | |
36086 | &2.5375E+00,2.4631E+00,2.3919E+00,2.3261E+00,2.2643E+00,2.2183E+00, | |
36087 | &2.1772E+00,2.1426E+00,2.1222E+00,2.1155E+00,2.1135E+00,2.1130E+00, | |
36088 | &2.1102E+00,2.1039E+00,2.0941E+00,2.0815E+00,2.0652E+00,2.0466E+00, | |
36089 | &2.0251E+00,2.0014E+00,1.9746E+00,1.9450E+00,1.9116E+00,1.8381E+00, | |
36090 | &1.7481E+00,1.6484E+00,1.5404E+00,1.4225E+00,1.2963E+00,1.1611E+00, | |
36091 | &1.0161E+00,8.6047E-01,6.9193E-01,5.0691E-01,2.9581E-01,0.0000E+00, | |
36092 | &4.2754E+00,4.2238E+00,4.1737E+00,4.1233E+00,4.0740E+00,4.0219E+00, | |
36093 | &3.9713E+00,3.9196E+00,3.8675E+00,3.8160E+00,3.7618E+00,3.7060E+00, | |
36094 | &3.6510E+00,3.6173E+00,3.5808E+00,3.5380E+00,3.4941E+00,3.4493E+00, | |
36095 | &3.4027E+00,3.3623E+00,3.3163E+00,3.2647E+00,3.2114E+00,3.1563E+00, | |
36096 | &3.0989E+00,3.0489E+00,2.9929E+00,2.9263E+00,2.8563E+00,2.7837E+00/ | |
36097 | DATA (XUVF_L(K),K= 1255, 1368) / | |
36098 | &2.7122E+00,2.6501E+00,2.5825E+00,2.5073E+00,2.4327E+00,2.3623E+00, | |
36099 | &2.2962E+00,2.2474E+00,2.2020E+00,2.1616E+00,2.1335E+00,2.1209E+00, | |
36100 | &2.1113E+00,2.1034E+00,2.0929E+00,2.0795E+00,2.0634E+00,2.0439E+00, | |
36101 | &2.0222E+00,1.9982E+00,1.9716E+00,1.9428E+00,1.9113E+00,1.8773E+00, | |
36102 | &1.8394E+00,1.7649E+00,1.6692E+00,1.5658E+00,1.4547E+00,1.3360E+00, | |
36103 | &1.2095E+00,1.0761E+00,9.3485E-01,7.8430E-01,6.2380E-01,4.5010E-01, | |
36104 | &2.5625E-01,0.0000E+00,4.3798E+00,4.3275E+00,4.2762E+00,4.2239E+00, | |
36105 | &4.1730E+00,4.1196E+00,4.0674E+00,4.0143E+00,3.9623E+00,3.9056E+00, | |
36106 | &3.8502E+00,3.7935E+00,3.7370E+00,3.7018E+00,3.6642E+00,3.6200E+00, | |
36107 | &3.5742E+00,3.5277E+00,3.4786E+00,3.4371E+00,3.3901E+00,3.3359E+00, | |
36108 | &3.2800E+00,3.2235E+00,3.1639E+00,3.1115E+00,3.0537E+00,2.9847E+00, | |
36109 | &2.9116E+00,2.8364E+00,2.7623E+00,2.6973E+00,2.6275E+00,2.5497E+00, | |
36110 | &2.4705E+00,2.3972E+00,2.3281E+00,2.2747E+00,2.2253E+00,2.1793E+00, | |
36111 | &2.1444E+00,2.1253E+00,2.1081E+00,2.0939E+00,2.0755E+00,2.0555E+00, | |
36112 | &2.0332E+00,2.0081E+00,1.9814E+00,1.9522E+00,1.9205E+00,1.8875E+00, | |
36113 | &1.8520E+00,1.8139E+00,1.7725E+00,1.6968E+00,1.5976E+00,1.4911E+00, | |
36114 | &1.3772E+00,1.2577E+00,1.1320E+00,1.0005E+00,8.6242E-01,7.1750E-01, | |
36115 | &5.6466E-01,4.0150E-01,2.2333E-01,0.0000E+00,4.4809E+00,4.4265E+00, | |
36116 | &4.3735E+00,4.3193E+00,4.2670E+00,4.2128E+00,4.1585E+00,4.1039E+00/ | |
36117 | DATA (XUVF_L(K),K= 1369, 1482) / | |
36118 | &4.0509E+00,3.9928E+00,3.9351E+00,3.8769E+00,3.8180E+00,3.7821E+00, | |
36119 | &3.7434E+00,3.6974E+00,3.6501E+00,3.6019E+00,3.5513E+00,3.5093E+00, | |
36120 | &3.4594E+00,3.4035E+00,3.3456E+00,3.2870E+00,3.2250E+00,3.1715E+00, | |
36121 | &3.1110E+00,3.0396E+00,2.9639E+00,2.8863E+00,2.8096E+00,2.7429E+00, | |
36122 | &2.6702E+00,2.5884E+00,2.5068E+00,2.4296E+00,2.3560E+00,2.3003E+00, | |
36123 | &2.2464E+00,2.1951E+00,2.1530E+00,2.1283E+00,2.1045E+00,2.0843E+00, | |
36124 | &2.0591E+00,2.0328E+00,2.0047E+00,1.9749E+00,1.9429E+00,1.9096E+00, | |
36125 | &1.8740E+00,1.8369E+00,1.7978E+00,1.7560E+00,1.7116E+00,1.6360E+00, | |
36126 | &1.5322E+00,1.4233E+00,1.3084E+00,1.1885E+00,1.0637E+00,9.3449E-01, | |
36127 | &7.9961E-01,6.6020E-01,5.1453E-01,3.6103E-01,1.9641E-01,0.0000E+00, | |
36128 | &4.6169E+00,4.5608E+00,4.5060E+00,4.4504E+00,4.3960E+00,4.3395E+00, | |
36129 | &4.2837E+00,4.2262E+00,4.1710E+00,4.1106E+00,4.0517E+00,3.9908E+00, | |
36130 | &3.9300E+00,3.8920E+00,3.8509E+00,3.8030E+00,3.7538E+00,3.7035E+00, | |
36131 | &3.6494E+00,3.6055E+00,3.5556E+00,3.4966E+00,3.4351E+00,3.3738E+00, | |
36132 | &3.3090E+00,3.2518E+00,3.1888E+00,3.1141E+00,3.0348E+00,2.9533E+00, | |
36133 | &2.8730E+00,2.8020E+00,2.7264E+00,2.6400E+00,2.5551E+00,2.4732E+00, | |
36134 | &2.3941E+00,2.3329E+00,2.2742E+00,2.2147E+00,2.1644E+00,2.1317E+00, | |
36135 | &2.0986E+00,2.0700E+00,2.0363E+00,2.0021E+00,1.9668E+00,1.9299E+00, | |
36136 | &1.8922E+00,1.8532E+00,1.8125E+00,1.7704E+00,1.7270E+00,1.6809E+00/ | |
36137 | DATA (XUVF_L(K),K= 1483, 1596) / | |
36138 | &1.6327E+00,1.5570E+00,1.4497E+00,1.3373E+00,1.2215E+00,1.1020E+00, | |
36139 | &9.7897E-01,8.5304E-01,7.2349E-01,5.9074E-01,4.5411E-01,3.1307E-01, | |
36140 | &1.6547E-01,0.0000E+00,4.7403E+00,4.6834E+00,4.6262E+00,4.5696E+00, | |
36141 | &4.5140E+00,4.4557E+00,4.3978E+00,4.3393E+00,4.2817E+00,4.2191E+00, | |
36142 | &4.1578E+00,4.0941E+00,4.0310E+00,3.9917E+00,3.9492E+00,3.8995E+00, | |
36143 | &3.8481E+00,3.7958E+00,3.7411E+00,3.6937E+00,3.6405E+00,3.5806E+00, | |
36144 | &3.5171E+00,3.4520E+00,3.3840E+00,3.3254E+00,3.2596E+00,3.1812E+00, | |
36145 | &3.0985E+00,3.0137E+00,2.9301E+00,2.8556E+00,2.7782E+00,2.6879E+00, | |
36146 | &2.5974E+00,2.5119E+00,2.4281E+00,2.3629E+00,2.2982E+00,2.2324E+00, | |
36147 | &2.1730E+00,2.1332E+00,2.0922E+00,2.0570E+00,2.0152E+00,1.9739E+00, | |
36148 | &1.9323E+00,1.8902E+00,1.8474E+00,1.8039E+00,1.7589E+00,1.7129E+00, | |
36149 | &1.6654E+00,1.6163E+00,1.5652E+00,1.4896E+00,1.3789E+00,1.2649E+00, | |
36150 | &1.1487E+00,1.0300E+00,9.0896E-01,7.8619E-01,6.6149E-01,5.3498E-01, | |
36151 | &4.0654E-01,2.7586E-01,1.4208E-01,0.0000E+00,4.8699E+00,4.8107E+00, | |
36152 | &4.7518E+00,4.6928E+00,4.6350E+00,4.5750E+00,4.5152E+00,4.4524E+00, | |
36153 | &4.3956E+00,4.3299E+00,4.2674E+00,4.2014E+00,4.1350E+00,4.0939E+00, | |
36154 | &4.0503E+00,3.9982E+00,3.9448E+00,3.8905E+00,3.8328E+00,3.7846E+00, | |
36155 | &3.7300E+00,3.6664E+00,3.5991E+00,3.5326E+00,3.4620E+00,3.3998E+00, | |
36156 | &3.3311E+00,3.2494E+00,3.1632E+00,3.0752E+00,2.9881E+00,2.9120E+00/ | |
36157 | DATA (XUVF_L(K),K= 1597, 1710) / | |
36158 | &2.8299E+00,2.7339E+00,2.6398E+00,2.5493E+00,2.4611E+00,2.3911E+00, | |
36159 | &2.3215E+00,2.2482E+00,2.1812E+00,2.1342E+00,2.0854E+00,2.0427E+00, | |
36160 | &1.9932E+00,1.9453E+00,1.8978E+00,1.8504E+00,1.8030E+00,1.7545E+00, | |
36161 | &1.7059E+00,1.6565E+00,1.6056E+00,1.5535E+00,1.4989E+00,1.4245E+00, | |
36162 | &1.3108E+00,1.1959E+00,1.0798E+00,9.6219E-01,8.4358E-01,7.2422E-01, | |
36163 | &6.0451E-01,4.8425E-01,3.6380E-01,2.4286E-01,1.2189E-01,0.0000E+00, | |
36164 | &4.9964E+00,4.9356E+00,4.8755E+00,4.8147E+00,4.7550E+00,4.6935E+00, | |
36165 | &4.6315E+00,4.5697E+00,4.5062E+00,4.4406E+00,4.3752E+00,4.3061E+00, | |
36166 | &4.2380E+00,4.1962E+00,4.1500E+00,4.0963E+00,4.0405E+00,3.9832E+00, | |
36167 | &3.9245E+00,3.8728E+00,3.8172E+00,3.7504E+00,3.6811E+00,3.6108E+00, | |
36168 | &3.5381E+00,3.4734E+00,3.4018E+00,3.3164E+00,3.2269E+00,3.1352E+00, | |
36169 | &3.0446E+00,2.9657E+00,2.8794E+00,2.7800E+00,2.6821E+00,2.5867E+00, | |
36170 | &2.4930E+00,2.4184E+00,2.3433E+00,2.2634E+00,2.1877E+00,2.1342E+00, | |
36171 | &2.0772E+00,2.0279E+00,1.9713E+00,1.9172E+00,1.8642E+00,1.8120E+00, | |
36172 | &1.7600E+00,1.7076E+00,1.6553E+00,1.6027E+00,1.5491E+00,1.4938E+00, | |
36173 | &1.4374E+00,1.3637E+00,1.2481E+00,1.1325E+00,1.0166E+00,9.0047E-01, | |
36174 | &7.8428E-01,6.6889E-01,5.5381E-01,4.3953E-01,3.2652E-01,2.1461E-01, | |
36175 | &1.0498E-01,0.0000E+00,5.1134E+00,5.0511E+00,4.9886E+00,4.9273E+00, | |
36176 | &4.8660E+00,4.8016E+00,4.7382E+00,4.6744E+00,4.6106E+00,4.5420E+00/ | |
36177 | DATA (XUVF_L(K),K= 1711, 1824) / | |
36178 | &4.4742E+00,4.4028E+00,4.3320E+00,4.2892E+00,4.2413E+00,4.1858E+00, | |
36179 | &4.1281E+00,4.0682E+00,4.0067E+00,3.9556E+00,3.8955E+00,3.8271E+00, | |
36180 | &3.7556E+00,3.6829E+00,3.6071E+00,3.5401E+00,3.4662E+00,3.3777E+00, | |
36181 | &3.2849E+00,3.1898E+00,3.0960E+00,3.0140E+00,2.9244E+00,2.8224E+00, | |
36182 | &2.7183E+00,2.6191E+00,2.5219E+00,2.4431E+00,2.3628E+00,2.2767E+00, | |
36183 | &2.1931E+00,2.1332E+00,2.0695E+00,2.0145E+00,1.9514E+00,1.8920E+00, | |
36184 | &1.8340E+00,1.7775E+00,1.7215E+00,1.6664E+00,1.6108E+00,1.5553E+00, | |
36185 | &1.4995E+00,1.4421E+00,1.3839E+00,1.3103E+00,1.1944E+00,1.0782E+00, | |
36186 | &9.6271E-01,8.4822E-01,7.3481E-01,6.2240E-01,5.1184E-01,4.0291E-01, | |
36187 | &2.9618E-01,1.9206E-01,9.1846E-02,0.0000E+00,5.2367E+00,5.1713E+00, | |
36188 | &5.1071E+00,5.0425E+00,4.9800E+00,4.9141E+00,4.8489E+00,4.7833E+00, | |
36189 | &4.7181E+00,4.6457E+00,4.5768E+00,4.5034E+00,4.4300E+00,4.3847E+00, | |
36190 | &4.3353E+00,4.2782E+00,4.2182E+00,4.1570E+00,4.0921E+00,4.0385E+00, | |
36191 | &3.9782E+00,3.9074E+00,3.8331E+00,3.7575E+00,3.6781E+00,3.6086E+00, | |
36192 | &3.5313E+00,3.4401E+00,3.3439E+00,3.2455E+00,3.1483E+00,3.0623E+00, | |
36193 | &2.9694E+00,2.8629E+00,2.7561E+00,2.6527E+00,2.5508E+00,2.4669E+00, | |
36194 | &2.3816E+00,2.2887E+00,2.1979E+00,2.1317E+00,2.0613E+00,2.0002E+00, | |
36195 | &1.9307E+00,1.8659E+00,1.8033E+00,1.7426E+00,1.6834E+00,1.6247E+00, | |
36196 | &1.5668E+00,1.5085E+00,1.4504E+00,1.3916E+00,1.3311E+00,1.2591E+00/ | |
36197 | DATA (XUVF_L(K),K= 1825, 1836) / | |
36198 | &1.1415E+00,1.0256E+00,9.1107E-01,7.9840E-01,6.8736E-01,5.7902E-01, | |
36199 | &4.7260E-01,3.6895E-01,2.6838E-01,1.7161E-01,8.0264E-02,0.0000E+00/ | |
36200 | DATA (XDVF_L(K),K= 1, 114) / | |
36201 | &1.4230E+00,1.4064E+00,1.3903E+00,1.3749E+00,1.3590E+00,1.3424E+00, | |
36202 | &1.3271E+00,1.3114E+00,1.2962E+00,1.2803E+00,1.2647E+00,1.2492E+00, | |
36203 | &1.2340E+00,1.2246E+00,1.2155E+00,1.2044E+00,1.1927E+00,1.1814E+00, | |
36204 | &1.1695E+00,1.1589E+00,1.1479E+00,1.1347E+00,1.1214E+00,1.1080E+00, | |
36205 | &1.0944E+00,1.0824E+00,1.0700E+00,1.0544E+00,1.0371E+00,1.0188E+00, | |
36206 | &9.9884E-01,9.8287E-01,9.6563E-01,9.4645E-01,9.2847E-01,9.1313E-01, | |
36207 | &9.0246E-01,8.9955E-01,9.0461E-01,9.2737E-01,9.7648E-01,1.0343E+00, | |
36208 | &1.1168E+00,1.2030E+00,1.3129E+00,1.4240E+00,1.5357E+00,1.6492E+00, | |
36209 | &1.7643E+00,1.8818E+00,2.0016E+00,2.1253E+00,2.2535E+00,2.3853E+00, | |
36210 | &2.5225E+00,2.5620E+00,2.7906E+00,3.0230E+00,3.2574E+00,3.4983E+00, | |
36211 | &3.7459E+00,4.0062E+00,4.2803E+00,4.5790E+00,4.9150E+00,5.3263E+00, | |
36212 | &5.9228E+00,0.0000E+00,1.4698E+00,1.4526E+00,1.4360E+00,1.4199E+00, | |
36213 | &1.4030E+00,1.3864E+00,1.3702E+00,1.3542E+00,1.3386E+00,1.3221E+00, | |
36214 | &1.3059E+00,1.2896E+00,1.2740E+00,1.2644E+00,1.2544E+00,1.2425E+00, | |
36215 | &1.2309E+00,1.2185E+00,1.2061E+00,1.1953E+00,1.1836E+00,1.1697E+00, | |
36216 | &1.1558E+00,1.1417E+00,1.1275E+00,1.1154E+00,1.1011E+00,1.0844E+00, | |
36217 | &1.0663E+00,1.0471E+00,1.0261E+00,1.0092E+00,9.9133E-01,9.7103E-01, | |
36218 | &9.5184E-01,9.3560E-01,9.2380E-01,9.1922E-01,9.2378E-01,9.4563E-01, | |
36219 | &9.9235E-01,1.0474E+00,1.1262E+00,1.2078E+00,1.3110E+00,1.4146E+00/ | |
36220 | DATA (XDVF_L(K),K= 115, 228) / | |
36221 | &1.5192E+00,1.6241E+00,1.7298E+00,1.8375E+00,1.9471E+00,2.0592E+00, | |
36222 | &2.1741E+00,2.2925E+00,2.4144E+00,2.4425E+00,2.6407E+00,2.8375E+00, | |
36223 | &3.0361E+00,3.2345E+00,3.4343E+00,3.6388E+00,3.8488E+00,4.0682E+00, | |
36224 | &4.3043E+00,4.5737E+00,4.9280E+00,0.0000E+00,1.5226E+00,1.5047E+00, | |
36225 | &1.4874E+00,1.4702E+00,1.4530E+00,1.4363E+00,1.4193E+00,1.4023E+00, | |
36226 | &1.3860E+00,1.3690E+00,1.3520E+00,1.3351E+00,1.3190E+00,1.3083E+00, | |
36227 | &1.2983E+00,1.2858E+00,1.2733E+00,1.2606E+00,1.2476E+00,1.2362E+00, | |
36228 | &1.2237E+00,1.2092E+00,1.1943E+00,1.1795E+00,1.1645E+00,1.1509E+00, | |
36229 | &1.1365E+00,1.1185E+00,1.0994E+00,1.0784E+00,1.0566E+00,1.0388E+00, | |
36230 | &1.0195E+00,9.9801E-01,9.7765E-01,9.6019E-01,9.4712E-01,9.4158E-01, | |
36231 | &9.4524E-01,9.6454E-01,1.0088E+00,1.0604E+00,1.1346E+00,1.2112E+00, | |
36232 | &1.3076E+00,1.4038E+00,1.4995E+00,1.5957E+00,1.6918E+00,1.7888E+00, | |
36233 | &1.8877E+00,1.9877E+00,2.0896E+00,2.1940E+00,2.2999E+00,2.3168E+00, | |
36234 | &2.4844E+00,2.6497E+00,2.8098E+00,2.9678E+00,3.1219E+00,3.2743E+00, | |
36235 | &3.4260E+00,3.5742E+00,3.7237E+00,3.8717E+00,4.0300E+00,0.0000E+00, | |
36236 | &1.5849E+00,1.5662E+00,1.5482E+00,1.5298E+00,1.5130E+00,1.4944E+00, | |
36237 | &1.4769E+00,1.4593E+00,1.4423E+00,1.4243E+00,1.4066E+00,1.3894E+00, | |
36238 | &1.3720E+00,1.3607E+00,1.3499E+00,1.3366E+00,1.3237E+00,1.3101E+00, | |
36239 | &1.2963E+00,1.2840E+00,1.2709E+00,1.2553E+00,1.2396E+00,1.2232E+00/ | |
36240 | DATA (XDVF_L(K),K= 229, 342) / | |
36241 | &1.2075E+00,1.1932E+00,1.1776E+00,1.1584E+00,1.1377E+00,1.1152E+00, | |
36242 | &1.0922E+00,1.0729E+00,1.0524E+00,1.0294E+00,1.0074E+00,9.8843E-01, | |
36243 | &9.7377E-01,9.6751E-01,9.6901E-01,9.8606E-01,1.0264E+00,1.0745E+00, | |
36244 | &1.1435E+00,1.2136E+00,1.3018E+00,1.3894E+00,1.4758E+00,1.5619E+00, | |
36245 | &1.6474E+00,1.7332E+00,1.8194E+00,1.9063E+00,1.9941E+00,2.0832E+00, | |
36246 | &2.1725E+00,2.1789E+00,2.3166E+00,2.4460E+00,2.5708E+00,2.6884E+00, | |
36247 | &2.7987E+00,2.9025E+00,2.9974E+00,3.0823E+00,3.1538E+00,3.2013E+00, | |
36248 | &3.2043E+00,0.0000E+00,1.6586E+00,1.6391E+00,1.6202E+00,1.6014E+00, | |
36249 | &1.5830E+00,1.5638E+00,1.5457E+00,1.5267E+00,1.5087E+00,1.4899E+00, | |
36250 | &1.4711E+00,1.4517E+00,1.4340E+00,1.4224E+00,1.4107E+00,1.3972E+00, | |
36251 | &1.3827E+00,1.3684E+00,1.3535E+00,1.3404E+00,1.3263E+00,1.3096E+00, | |
36252 | &1.2927E+00,1.2758E+00,1.2575E+00,1.2422E+00,1.2250E+00,1.2046E+00, | |
36253 | &1.1821E+00,1.1579E+00,1.1331E+00,1.1127E+00,1.0905E+00,1.0655E+00, | |
36254 | &1.0415E+00,1.0207E+00,1.0042E+00,9.9612E-01,9.9507E-01,1.0089E+00, | |
36255 | &1.0451E+00,1.0887E+00,1.1514E+00,1.2146E+00,1.2936E+00,1.3711E+00, | |
36256 | &1.4469E+00,1.5220E+00,1.5960E+00,1.6694E+00,1.7428E+00,1.8159E+00, | |
36257 | &1.8894E+00,1.9620E+00,2.0344E+00,2.0313E+00,2.1357E+00,2.2333E+00, | |
36258 | &2.3215E+00,2.4009E+00,2.4706E+00,2.5292E+00,2.5750E+00,2.6036E+00, | |
36259 | &2.6096E+00,2.5783E+00,2.4673E+00,0.0000E+00,1.7269E+00,1.7065E+00/ | |
36260 | DATA (XDVF_L(K),K= 343, 456) / | |
36261 | &1.6866E+00,1.6676E+00,1.6480E+00,1.6279E+00,1.6089E+00,1.5891E+00, | |
36262 | &1.5701E+00,1.5502E+00,1.5307E+00,1.5113E+00,1.4910E+00,1.4799E+00, | |
36263 | &1.4673E+00,1.4526E+00,1.4373E+00,1.4221E+00,1.4060E+00,1.3922E+00, | |
36264 | &1.3771E+00,1.3596E+00,1.3414E+00,1.3234E+00,1.3045E+00,1.2879E+00, | |
36265 | &1.2689E+00,1.2468E+00,1.2227E+00,1.1966E+00,1.1706E+00,1.1487E+00, | |
36266 | &1.1248E+00,1.0980E+00,1.0724E+00,1.0495E+00,1.0310E+00,1.0212E+00, | |
36267 | &1.0181E+00,1.0291E+00,1.0609E+00,1.1002E+00,1.1563E+00,1.2136E+00, | |
36268 | &1.2840E+00,1.3528E+00,1.4201E+00,1.4854E+00,1.5492E+00,1.6125E+00, | |
36269 | &1.6751E+00,1.7368E+00,1.7981E+00,1.8579E+00,1.9157E+00,1.9057E+00, | |
36270 | &1.9875E+00,2.0577E+00,2.1190E+00,2.1700E+00,2.2094E+00,2.2370E+00, | |
36271 | &2.2484E+00,2.2403E+00,2.2047E+00,2.1261E+00,1.9567E+00,0.0000E+00, | |
36272 | &1.8047E+00,1.7833E+00,1.7626E+00,1.7418E+00,1.7220E+00,1.7009E+00, | |
36273 | &1.6810E+00,1.6603E+00,1.6403E+00,1.6193E+00,1.5986E+00,1.5775E+00, | |
36274 | &1.5570E+00,1.5441E+00,1.5309E+00,1.5156E+00,1.4991E+00,1.4828E+00, | |
36275 | &1.4658E+00,1.4510E+00,1.4350E+00,1.4160E+00,1.3966E+00,1.3772E+00, | |
36276 | &1.3565E+00,1.3386E+00,1.3184E+00,1.2942E+00,1.2680E+00,1.2404E+00, | |
36277 | &1.2125E+00,1.1887E+00,1.1631E+00,1.1342E+00,1.1064E+00,1.0813E+00, | |
36278 | &1.0608E+00,1.0480E+00,1.0426E+00,1.0500E+00,1.0774E+00,1.1111E+00, | |
36279 | &1.1608E+00,1.2107E+00,1.2719E+00,1.3315E+00,1.3886E+00,1.4445E+00/ | |
36280 | DATA (XDVF_L(K),K= 457, 570) / | |
36281 | &1.4984E+00,1.5505E+00,1.6020E+00,1.6524E+00,1.7009E+00,1.7480E+00, | |
36282 | &1.7926E+00,1.7763E+00,1.8327E+00,1.8794E+00,1.9154E+00,1.9405E+00, | |
36283 | &1.9531E+00,1.9537E+00,1.9362E+00,1.8986E+00,1.8325E+00,1.7203E+00, | |
36284 | &1.5163E+00,0.0000E+00,1.8755E+00,1.8533E+00,1.8314E+00,1.8106E+00, | |
36285 | &1.7890E+00,1.7672E+00,1.7464E+00,1.7248E+00,1.7038E+00,1.6817E+00, | |
36286 | &1.6601E+00,1.6385E+00,1.6160E+00,1.6033E+00,1.5889E+00,1.5721E+00, | |
36287 | &1.5552E+00,1.5380E+00,1.5199E+00,1.5042E+00,1.4871E+00,1.4670E+00, | |
36288 | &1.4463E+00,1.4249E+00,1.4036E+00,1.3843E+00,1.3630E+00,1.3364E+00, | |
36289 | &1.3086E+00,1.2791E+00,1.2500E+00,1.2245E+00,1.1971E+00,1.1662E+00, | |
36290 | &1.1361E+00,1.1090E+00,1.0858E+00,1.0721E+00,1.0641E+00,1.0676E+00, | |
36291 | &1.0898E+00,1.1195E+00,1.1627E+00,1.2069E+00,1.2603E+00,1.3118E+00, | |
36292 | &1.3607E+00,1.4079E+00,1.4534E+00,1.4968E+00,1.5392E+00,1.5794E+00, | |
36293 | &1.6181E+00,1.6552E+00,1.6888E+00,1.6690E+00,1.7073E+00,1.7353E+00, | |
36294 | &1.7530E+00,1.7595E+00,1.7531E+00,1.7338E+00,1.6988E+00,1.6428E+00, | |
36295 | &1.5583E+00,1.4293E+00,1.2136E+00,0.0000E+00,1.9470E+00,1.9238E+00, | |
36296 | &1.9021E+00,1.8782E+00,1.8570E+00,1.8343E+00,1.8123E+00,1.7898E+00, | |
36297 | &1.7680E+00,1.7449E+00,1.7222E+00,1.6994E+00,1.6760E+00,1.6624E+00, | |
36298 | &1.6469E+00,1.6299E+00,1.6118E+00,1.5933E+00,1.5742E+00,1.5574E+00, | |
36299 | &1.5392E+00,1.5179E+00,1.4955E+00,1.4738E+00,1.4506E+00,1.4300E+00/ | |
36300 | DATA (XDVF_L(K),K= 571, 684) / | |
36301 | &1.4069E+00,1.3792E+00,1.3492E+00,1.3178E+00,1.2868E+00,1.2597E+00, | |
36302 | &1.2307E+00,1.1976E+00,1.1654E+00,1.1363E+00,1.1108E+00,1.0945E+00, | |
36303 | &1.0840E+00,1.0845E+00,1.1017E+00,1.1268E+00,1.1637E+00,1.2016E+00, | |
36304 | &1.2473E+00,1.2910E+00,1.3324E+00,1.3719E+00,1.4090E+00,1.4450E+00, | |
36305 | &1.4784E+00,1.5109E+00,1.5404E+00,1.5681E+00,1.5925E+00,1.5689E+00, | |
36306 | &1.5916E+00,1.6043E+00,1.6067E+00,1.5981E+00,1.5779E+00,1.5449E+00, | |
36307 | &1.4949E+00,1.4262E+00,1.3303E+00,1.1932E+00,9.7657E-01,0.0000E+00, | |
36308 | &2.0122E+00,1.9881E+00,1.9640E+00,1.9418E+00,1.9190E+00,1.8954E+00, | |
36309 | &1.8721E+00,1.8492E+00,1.8262E+00,1.8024E+00,1.7784E+00,1.7550E+00, | |
36310 | &1.7300E+00,1.7157E+00,1.6999E+00,1.6818E+00,1.6627E+00,1.6435E+00, | |
36311 | &1.6233E+00,1.6058E+00,1.5866E+00,1.5643E+00,1.5417E+00,1.5178E+00, | |
36312 | &1.4926E+00,1.4705E+00,1.4465E+00,1.4174E+00,1.3856E+00,1.3527E+00, | |
36313 | &1.3198E+00,1.2914E+00,1.2605E+00,1.2257E+00,1.1915E+00,1.1601E+00, | |
36314 | &1.1326E+00,1.1142E+00,1.1016E+00,1.0982E+00,1.1114E+00,1.1321E+00, | |
36315 | &1.1637E+00,1.1958E+00,1.2352E+00,1.2722E+00,1.3071E+00,1.3397E+00, | |
36316 | &1.3704E+00,1.3995E+00,1.4267E+00,1.4516E+00,1.4736E+00,1.4942E+00, | |
36317 | &1.5100E+00,1.4848E+00,1.4955E+00,1.4964E+00,1.4873E+00,1.4675E+00, | |
36318 | &1.4366E+00,1.3933E+00,1.3349E+00,1.2585E+00,1.1565E+00,1.0171E+00, | |
36319 | &8.0601E-01,0.0000E+00,2.0789E+00,2.0539E+00,2.0294E+00,2.0053E+00/ | |
36320 | DATA (XDVF_L(K),K= 685, 798) / | |
36321 | &1.9820E+00,1.9581E+00,1.9336E+00,1.9096E+00,1.8860E+00,1.8609E+00, | |
36322 | &1.8367E+00,1.8106E+00,1.7860E+00,1.7706E+00,1.7543E+00,1.7350E+00, | |
36323 | &1.7150E+00,1.6945E+00,1.6735E+00,1.6550E+00,1.6349E+00,1.6112E+00, | |
36324 | &1.5864E+00,1.5617E+00,1.5356E+00,1.5128E+00,1.4868E+00,1.4555E+00, | |
36325 | &1.4224E+00,1.3876E+00,1.3532E+00,1.3231E+00,1.2904E+00,1.2536E+00, | |
36326 | &1.2173E+00,1.1838E+00,1.1545E+00,1.1338E+00,1.1185E+00,1.1113E+00, | |
36327 | &1.1199E+00,1.1362E+00,1.1627E+00,1.1895E+00,1.2222E+00,1.2529E+00, | |
36328 | &1.2813E+00,1.3080E+00,1.3324E+00,1.3546E+00,1.3756E+00,1.3938E+00, | |
36329 | &1.4103E+00,1.4232E+00,1.4319E+00,1.4055E+00,1.4052E+00,1.3959E+00, | |
36330 | &1.3768E+00,1.3480E+00,1.3084E+00,1.2576E+00,1.1928E+00,1.1110E+00, | |
36331 | &1.0066E+00,8.6804E-01,6.6615E-01,0.0000E+00,2.1434E+00,2.1178E+00, | |
36332 | &2.0930E+00,2.0676E+00,2.0440E+00,2.0184E+00,1.9935E+00,1.9686E+00, | |
36333 | &1.9439E+00,1.9179E+00,1.8915E+00,1.8663E+00,1.8400E+00,1.8239E+00, | |
36334 | &1.8067E+00,1.7863E+00,1.7654E+00,1.7440E+00,1.7219E+00,1.7025E+00, | |
36335 | &1.6814E+00,1.6565E+00,1.6311E+00,1.6045E+00,1.5766E+00,1.5526E+00, | |
36336 | &1.5250E+00,1.4925E+00,1.4574E+00,1.4213E+00,1.3849E+00,1.3532E+00, | |
36337 | &1.3191E+00,1.2800E+00,1.2418E+00,1.2062E+00,1.1743E+00,1.1517E+00, | |
36338 | &1.1338E+00,1.1237E+00,1.1272E+00,1.1399E+00,1.1608E+00,1.1828E+00, | |
36339 | &1.2092E+00,1.2341E+00,1.2570E+00,1.2774E+00,1.2962E+00,1.3135E+00/ | |
36340 | DATA (XDVF_L(K),K= 799, 912) / | |
36341 | &1.3280E+00,1.3406E+00,1.3511E+00,1.3588E+00,1.3613E+00,1.3335E+00, | |
36342 | &1.3246E+00,1.3067E+00,1.2801E+00,1.2441E+00,1.1985E+00,1.1418E+00, | |
36343 | &1.0724E+00,9.8806E-01,8.8293E-01,7.4746E-01,5.5665E-01,0.0000E+00, | |
36344 | &2.2035E+00,2.1769E+00,2.1514E+00,2.1259E+00,2.1000E+00,2.0743E+00, | |
36345 | &2.0488E+00,2.0226E+00,1.9973E+00,1.9702E+00,1.9428E+00,1.9166E+00, | |
36346 | &1.8890E+00,1.8729E+00,1.8548E+00,1.8337E+00,1.8116E+00,1.7895E+00, | |
36347 | &1.7662E+00,1.7461E+00,1.7239E+00,1.6980E+00,1.6714E+00,1.6436E+00, | |
36348 | &1.6146E+00,1.5889E+00,1.5604E+00,1.5266E+00,1.4895E+00,1.4515E+00, | |
36349 | &1.4138E+00,1.3806E+00,1.3448E+00,1.3040E+00,1.2638E+00,1.2261E+00, | |
36350 | &1.1920E+00,1.1669E+00,1.1469E+00,1.1341E+00,1.1335E+00,1.1420E+00, | |
36351 | &1.1583E+00,1.1760E+00,1.1971E+00,1.2168E+00,1.2343E+00,1.2501E+00, | |
36352 | &1.2640E+00,1.2762E+00,1.2866E+00,1.2942E+00,1.2996E+00,1.3020E+00, | |
36353 | &1.3003E+00,1.2725E+00,1.2557E+00,1.2312E+00,1.1982E+00,1.1569E+00, | |
36354 | &1.1068E+00,1.0465E+00,9.7460E-01,8.8884E-01,7.8459E-01,6.5333E-01, | |
36355 | &4.7359E-01,0.0000E+00,2.2800E+00,2.2524E+00,2.2256E+00,2.1987E+00, | |
36356 | &2.1730E+00,2.1459E+00,2.1192E+00,2.0922E+00,2.0656E+00,2.0374E+00, | |
36357 | &2.0100E+00,1.9802E+00,1.9520E+00,1.9346E+00,1.9156E+00,1.8937E+00, | |
36358 | &1.8706E+00,1.8475E+00,1.8228E+00,1.8017E+00,1.7783E+00,1.7509E+00, | |
36359 | &1.7221E+00,1.6937E+00,1.6627E+00,1.6354E+00,1.6050E+00,1.5688E+00/ | |
36360 | DATA (XDVF_L(K),K= 913, 1026) / | |
36361 | &1.5301E+00,1.4898E+00,1.4503E+00,1.4150E+00,1.3772E+00,1.3339E+00, | |
36362 | &1.2911E+00,1.2510E+00,1.2138E+00,1.1866E+00,1.1637E+00,1.1458E+00, | |
36363 | &1.1403E+00,1.1441E+00,1.1548E+00,1.1669E+00,1.1817E+00,1.1950E+00, | |
36364 | &1.2065E+00,1.2163E+00,1.2249E+00,1.2313E+00,1.2355E+00,1.2379E+00, | |
36365 | &1.2379E+00,1.2348E+00,1.2275E+00,1.1987E+00,1.1744E+00,1.1427E+00, | |
36366 | &1.1035E+00,1.0570E+00,1.0018E+00,9.3862E-01,8.6494E-01,7.7913E-01, | |
36367 | &6.7747E-01,5.5266E-01,3.8741E-01,0.0000E+00,2.3524E+00,2.3243E+00, | |
36368 | &2.2963E+00,2.2689E+00,2.2420E+00,2.2137E+00,2.1858E+00,2.1579E+00, | |
36369 | &2.1301E+00,2.1011E+00,2.0718E+00,2.0424E+00,2.0120E+00,1.9937E+00, | |
36370 | &1.9743E+00,1.9509E+00,1.9267E+00,1.9020E+00,1.8763E+00,1.8541E+00, | |
36371 | &1.8295E+00,1.8006E+00,1.7713E+00,1.7402E+00,1.7077E+00,1.6794E+00, | |
36372 | &1.6475E+00,1.6087E+00,1.5679E+00,1.5259E+00,1.4840E+00,1.4470E+00, | |
36373 | &1.4072E+00,1.3615E+00,1.3163E+00,1.2738E+00,1.2336E+00,1.2045E+00, | |
36374 | &1.1783E+00,1.1563E+00,1.1459E+00,1.1457E+00,1.1504E+00,1.1577E+00, | |
36375 | &1.1662E+00,1.1742E+00,1.1807E+00,1.1857E+00,1.1886E+00,1.1902E+00, | |
36376 | &1.1899E+00,1.1878E+00,1.1830E+00,1.1751E+00,1.1633E+00,1.1345E+00, | |
36377 | &1.1039E+00,1.0667E+00,1.0230E+00,9.7228E-01,9.1417E-01,8.4905E-01, | |
36378 | &7.7478E-01,6.9004E-01,5.9155E-01,4.7371E-01,3.2191E-01,0.0000E+00, | |
36379 | &2.4233E+00,2.3947E+00,2.3653E+00,2.3365E+00,2.3090E+00,2.2800E+00/ | |
36380 | DATA (XDVF_L(K),K= 1027, 1140) / | |
36381 | &2.2512E+00,2.2220E+00,2.1934E+00,2.1628E+00,2.1319E+00,2.1007E+00, | |
36382 | &2.0700E+00,2.0512E+00,2.0301E+00,2.0057E+00,1.9809E+00,1.9549E+00, | |
36383 | &1.9281E+00,1.9049E+00,1.8791E+00,1.8497E+00,1.8175E+00,1.7854E+00, | |
36384 | &1.7507E+00,1.7209E+00,1.6878E+00,1.6474E+00,1.6047E+00,1.5603E+00, | |
36385 | &1.5164E+00,1.4777E+00,1.4358E+00,1.3879E+00,1.3403E+00,1.2952E+00, | |
36386 | &1.2523E+00,1.2206E+00,1.1913E+00,1.1661E+00,1.1505E+00,1.1462E+00, | |
36387 | &1.1460E+00,1.1481E+00,1.1518E+00,1.1545E+00,1.1559E+00,1.1562E+00, | |
36388 | &1.1548E+00,1.1523E+00,1.1478E+00,1.1414E+00,1.1331E+00,1.1212E+00, | |
36389 | &1.1055E+00,1.0763E+00,1.0405E+00,9.9877E-01,9.5130E-01,8.9815E-01, | |
36390 | &8.3813E-01,7.7188E-01,6.9792E-01,6.1492E-01,5.2020E-01,4.0920E-01, | |
36391 | &2.7020E-01,0.0000E+00,2.4906E+00,2.4607E+00,2.4307E+00,2.4014E+00, | |
36392 | &2.3730E+00,2.3427E+00,2.3127E+00,2.2828E+00,2.2528E+00,2.2213E+00, | |
36393 | &2.1903E+00,2.1577E+00,2.1250E+00,2.1053E+00,2.0839E+00,2.0583E+00, | |
36394 | &2.0318E+00,2.0051E+00,1.9771E+00,1.9527E+00,1.9259E+00,1.8935E+00, | |
36395 | &1.8607E+00,1.8269E+00,1.7917E+00,1.7606E+00,1.7253E+00,1.6833E+00, | |
36396 | &1.6387E+00,1.5925E+00,1.5465E+00,1.5061E+00,1.4624E+00,1.4121E+00, | |
36397 | &1.3623E+00,1.3152E+00,1.2700E+00,1.2349E+00,1.2036E+00,1.1745E+00, | |
36398 | &1.1544E+00,1.1457E+00,1.1410E+00,1.1389E+00,1.1378E+00,1.1357E+00, | |
36399 | &1.1332E+00,1.1290E+00,1.1244E+00,1.1176E+00,1.1099E+00,1.0996E+00/ | |
36400 | DATA (XDVF_L(K),K= 1141, 1254) / | |
36401 | &1.0875E+00,1.0729E+00,1.0538E+00,1.0249E+00,9.8511E-01,9.3994E-01, | |
36402 | &8.8948E-01,8.3410E-01,7.7332E-01,7.0681E-01,6.3377E-01,5.5280E-01, | |
36403 | &4.6214E-01,3.5755E-01,2.2965E-01,0.0000E+00,2.5589E+00,2.5291E+00, | |
36404 | &2.4979E+00,2.4676E+00,2.4370E+00,2.4060E+00,2.3753E+00,2.3443E+00, | |
36405 | &2.3135E+00,2.2809E+00,2.2486E+00,2.2146E+00,2.1810E+00,2.1602E+00, | |
36406 | &2.1376E+00,2.1114E+00,2.0841E+00,2.0557E+00,2.0265E+00,2.0011E+00, | |
36407 | &1.9730E+00,1.9392E+00,1.9055E+00,1.8697E+00,1.8327E+00,1.8003E+00, | |
36408 | &1.7635E+00,1.7197E+00,1.6727E+00,1.6246E+00,1.5770E+00,1.5346E+00, | |
36409 | &1.4890E+00,1.4363E+00,1.3841E+00,1.3341E+00,1.2867E+00,1.2492E+00, | |
36410 | &1.2151E+00,1.1824E+00,1.1578E+00,1.1451E+00,1.1356E+00,1.1298E+00, | |
36411 | &1.1233E+00,1.1169E+00,1.1105E+00,1.1027E+00,1.0940E+00,1.0840E+00, | |
36412 | &1.0726E+00,1.0592E+00,1.0444E+00,1.0265E+00,1.0045E+00,9.7613E-01, | |
36413 | &9.3249E-01,8.8451E-01,8.3193E-01,7.7510E-01,7.1373E-01,6.4749E-01, | |
36414 | &5.7554E-01,4.9725E-01,4.1072E-01,3.1254E-01,1.9551E-01,0.0000E+00, | |
36415 | &2.6244E+00,2.5927E+00,2.5615E+00,2.5299E+00,2.4990E+00,2.4671E+00, | |
36416 | &2.4356E+00,2.4034E+00,2.3717E+00,2.3377E+00,2.3034E+00,2.2689E+00, | |
36417 | &2.2340E+00,2.2126E+00,2.1892E+00,2.1616E+00,2.1331E+00,2.1040E+00, | |
36418 | &2.0736E+00,2.0471E+00,2.0180E+00,1.9830E+00,1.9472E+00,1.9112E+00, | |
36419 | &1.8717E+00,1.8375E+00,1.7996E+00,1.7538E+00,1.7053E+00,1.6548E+00/ | |
36420 | DATA (XDVF_L(K),K= 1255, 1368) / | |
36421 | &1.6053E+00,1.5612E+00,1.5138E+00,1.4590E+00,1.4045E+00,1.3516E+00, | |
36422 | &1.3023E+00,1.2626E+00,1.2251E+00,1.1889E+00,1.1601E+00,1.1441E+00, | |
36423 | &1.1302E+00,1.1201E+00,1.1098E+00,1.0996E+00,1.0888E+00,1.0782E+00, | |
36424 | &1.0659E+00,1.0531E+00,1.0388E+00,1.0228E+00,1.0047E+00,9.8480E-01, | |
36425 | &9.6040E-01,9.3234E-01,8.8589E-01,8.3563E-01,7.8162E-01,7.2366E-01, | |
36426 | &6.6215E-01,5.9658E-01,5.2617E-01,4.5043E-01,3.6787E-01,2.7575E-01, | |
36427 | &1.6826E-01,0.0000E+00,2.6886E+00,2.6564E+00,2.6234E+00,2.5908E+00, | |
36428 | &2.5600E+00,2.5268E+00,2.4943E+00,2.4612E+00,2.4283E+00,2.3924E+00, | |
36429 | &2.3582E+00,2.3219E+00,2.2860E+00,2.2642E+00,2.2394E+00,2.2113E+00, | |
36430 | &2.1817E+00,2.1512E+00,2.1198E+00,2.0920E+00,2.0618E+00,2.0268E+00, | |
36431 | &1.9890E+00,1.9503E+00,1.9098E+00,1.8739E+00,1.8343E+00,1.7867E+00, | |
36432 | &1.7365E+00,1.6843E+00,1.6329E+00,1.5870E+00,1.5377E+00,1.4807E+00, | |
36433 | &1.4239E+00,1.3692E+00,1.3169E+00,1.2751E+00,1.2350E+00,1.1954E+00, | |
36434 | &1.1624E+00,1.1425E+00,1.1247E+00,1.1110E+00,1.0963E+00,1.0827E+00, | |
36435 | &1.0687E+00,1.0547E+00,1.0396E+00,1.0240E+00,1.0070E+00,9.8853E-01, | |
36436 | &9.6834E-01,9.4569E-01,9.1962E-01,8.9220E-01,8.4321E-01,7.9105E-01, | |
36437 | &7.3592E-01,6.7777E-01,6.1620E-01,5.5143E-01,4.8272E-01,4.0962E-01, | |
36438 | &3.3102E-01,2.4455E-01,1.4574E-01,0.0000E+00,2.7496E+00,2.7153E+00, | |
36439 | &2.6835E+00,2.6504E+00,2.6180E+00,2.5834E+00,2.5502E+00,2.5161E+00/ | |
36440 | DATA (XDVF_L(K),K= 1369, 1482) / | |
36441 | &2.4824E+00,2.4466E+00,2.4095E+00,2.3736E+00,2.3360E+00,2.3124E+00, | |
36442 | &2.2875E+00,2.2580E+00,2.2274E+00,2.1960E+00,2.1631E+00,2.1347E+00, | |
36443 | &2.1032E+00,2.0670E+00,2.0277E+00,1.9882E+00,1.9458E+00,1.9086E+00, | |
36444 | &1.8675E+00,1.8179E+00,1.7658E+00,1.7122E+00,1.6586E+00,1.6112E+00, | |
36445 | &1.5600E+00,1.5010E+00,1.4420E+00,1.3855E+00,1.3294E+00,1.2858E+00, | |
36446 | &1.2435E+00,1.2006E+00,1.1641E+00,1.1410E+00,1.1193E+00,1.1023E+00, | |
36447 | &1.0837E+00,1.0664E+00,1.0496E+00,1.0329E+00,1.0157E+00,9.9745E-01, | |
36448 | &9.7803E-01,9.5735E-01,9.3539E-01,9.1075E-01,8.8302E-01,8.5608E-01, | |
36449 | &8.0509E-01,7.5168E-01,6.9580E-01,6.3743E-01,5.7619E-01,5.1233E-01, | |
36450 | &4.4547E-01,3.7496E-01,2.9995E-01,2.1862E-01,1.2745E-01,0.0000E+00, | |
36451 | &2.8331E+00,2.7978E+00,2.7648E+00,2.7299E+00,2.6960E+00,2.6609E+00, | |
36452 | &2.6263E+00,2.5910E+00,2.5561E+00,2.5197E+00,2.4802E+00,2.4424E+00, | |
36453 | &2.4030E+00,2.3791E+00,2.3526E+00,2.3216E+00,2.2897E+00,2.2570E+00, | |
36454 | &2.2225E+00,2.1925E+00,2.1595E+00,2.1199E+00,2.0799E+00,2.0383E+00, | |
36455 | &1.9938E+00,1.9551E+00,1.9121E+00,1.8601E+00,1.8054E+00,1.7494E+00, | |
36456 | &1.6932E+00,1.6435E+00,1.5898E+00,1.5280E+00,1.4659E+00,1.4056E+00, | |
36457 | &1.3471E+00,1.3010E+00,1.2550E+00,1.2078E+00,1.1652E+00,1.1383E+00, | |
36458 | &1.1114E+00,1.0902E+00,1.0668E+00,1.0451E+00,1.0248E+00,1.0039E+00, | |
36459 | &9.8353E-01,9.6205E-01,9.4076E-01,9.1705E-01,8.9229E-01,8.6577E-01/ | |
36460 | DATA (XDVF_L(K),K= 1483, 1596) / | |
36461 | &8.3604E-01,8.0985E-01,7.5687E-01,7.0190E-01,6.4516E-01,5.8700E-01, | |
36462 | &5.2660E-01,4.6452E-01,3.9995E-01,3.3310E-01,2.6289E-01,1.8826E-01, | |
36463 | &1.0655E-01,0.0000E+00,2.9096E+00,2.8732E+00,2.8390E+00,2.8027E+00, | |
36464 | &2.7690E+00,2.7325E+00,2.6961E+00,2.6597E+00,2.6231E+00,2.5833E+00, | |
36465 | &2.5456E+00,2.5047E+00,2.4650E+00,2.4391E+00,2.4120E+00,2.3799E+00, | |
36466 | &2.3462E+00,2.3123E+00,2.2763E+00,2.2451E+00,2.2108E+00,2.1692E+00, | |
36467 | &2.1276E+00,2.0835E+00,2.0378E+00,1.9974E+00,1.9525E+00,1.8983E+00, | |
36468 | &1.8413E+00,1.7827E+00,1.7243E+00,1.6725E+00,1.6166E+00,1.5520E+00, | |
36469 | &1.4872E+00,1.4244E+00,1.3627E+00,1.3136E+00,1.2649E+00,1.2130E+00, | |
36470 | &1.1663E+00,1.1352E+00,1.1040E+00,1.0787E+00,1.0514E+00,1.0264E+00, | |
36471 | &1.0021E+00,9.7883E-01,9.5548E-01,9.3171E-01,9.0763E-01,8.8283E-01, | |
36472 | &8.5596E-01,8.2732E-01,7.9601E-01,7.7056E-01,7.1598E-01,6.6027E-01, | |
36473 | &6.0340E-01,5.4514E-01,4.8601E-01,4.2556E-01,3.6359E-01,2.9984E-01, | |
36474 | &2.3396E-01,1.6486E-01,9.0844E-02,0.0000E+00,2.9880E+00,2.9510E+00, | |
36475 | &2.9150E+00,2.8782E+00,2.8430E+00,2.8048E+00,2.7677E+00,2.7301E+00, | |
36476 | &2.6924E+00,2.6517E+00,2.6110E+00,2.5696E+00,2.5280E+00,2.5017E+00, | |
36477 | &2.4728E+00,2.4393E+00,2.4042E+00,2.3687E+00,2.3313E+00,2.2988E+00, | |
36478 | &2.2631E+00,2.2204E+00,2.1768E+00,2.1312E+00,2.0828E+00,2.0405E+00, | |
36479 | &1.9928E+00,1.9364E+00,1.8772E+00,1.8164E+00,1.7558E+00,1.7018E+00/ | |
36480 | DATA (XDVF_L(K),K= 1597, 1710) / | |
36481 | &1.6434E+00,1.5762E+00,1.5084E+00,1.4432E+00,1.3783E+00,1.3261E+00, | |
36482 | &1.2741E+00,1.2182E+00,1.1669E+00,1.1315E+00,1.0961E+00,1.0671E+00, | |
36483 | &1.0360E+00,1.0071E+00,9.7992E-01,9.5371E-01,9.2801E-01,9.0200E-01, | |
36484 | &8.7588E-01,8.4862E-01,8.2038E-01,7.9020E-01,7.5770E-01,7.3298E-01, | |
36485 | &6.7721E-01,6.2090E-01,5.6394E-01,5.0631E-01,4.4841E-01,3.8970E-01, | |
36486 | &3.3019E-01,2.6973E-01,2.0791E-01,1.4420E-01,7.7416E-02,0.0000E+00, | |
36487 | &3.0661E+00,3.0288E+00,2.9911E+00,2.9537E+00,2.9160E+00,2.8778E+00, | |
36488 | &2.8392E+00,2.8000E+00,2.7610E+00,2.7200E+00,2.6782E+00,2.6345E+00, | |
36489 | &2.5900E+00,2.5625E+00,2.5329E+00,2.4982E+00,2.4617E+00,2.4247E+00, | |
36490 | &2.3857E+00,2.3518E+00,2.3145E+00,2.2697E+00,2.2245E+00,2.1764E+00, | |
36491 | &2.1269E+00,2.0819E+00,2.0331E+00,1.9746E+00,1.9126E+00,1.8497E+00, | |
36492 | &1.7862E+00,1.7303E+00,1.6696E+00,1.5995E+00,1.5285E+00,1.4608E+00, | |
36493 | &1.3929E+00,1.3377E+00,1.2826E+00,1.2228E+00,1.1669E+00,1.1279E+00, | |
36494 | &1.0882E+00,1.0555E+00,1.0205E+00,9.8876E-01,9.5876E-01,9.2969E-01, | |
36495 | &9.0171E-01,8.7356E-01,8.4551E-01,8.1668E-01,7.8701E-01,7.5564E-01, | |
36496 | &7.2196E-01,6.9797E-01,6.4121E-01,5.8469E-01,5.2810E-01,4.7131E-01, | |
36497 | &4.1460E-01,3.5783E-01,3.0063E-01,2.4338E-01,1.8544E-01,1.2660E-01, | |
36498 | &6.6270E-02,0.0000E+00,3.1379E+00,3.0995E+00,3.0600E+00,3.0213E+00, | |
36499 | &2.9840E+00,2.9442E+00,2.9047E+00,2.8641E+00,2.8239E+00,2.7813E+00/ | |
36500 | DATA (XDVF_L(K),K= 1711, 1824) / | |
36501 | &2.7383E+00,2.6928E+00,2.6470E+00,2.6191E+00,2.5880E+00,2.5519E+00, | |
36502 | &2.5145E+00,2.4761E+00,2.4357E+00,2.4004E+00,2.3615E+00,2.3153E+00, | |
36503 | &2.2678E+00,2.2180E+00,2.1669E+00,2.1208E+00,2.0699E+00,2.0087E+00, | |
36504 | &1.9447E+00,1.8795E+00,1.8139E+00,1.7558E+00,1.6930E+00,1.6205E+00, | |
36505 | &1.5467E+00,1.4759E+00,1.4054E+00,1.3484E+00,1.2895E+00,1.2267E+00, | |
36506 | &1.1663E+00,1.1242E+00,1.0808E+00,1.0449E+00,1.0065E+00,9.7194E-01, | |
36507 | &9.3967E-01,9.0840E-01,8.7834E-01,8.4891E-01,8.1928E-01,7.8930E-01, | |
36508 | &7.5803E-01,7.2562E-01,6.9124E-01,6.6796E-01,6.1058E-01,5.5392E-01, | |
36509 | &4.9752E-01,4.4176E-01,3.8633E-01,3.3127E-01,2.7648E-01,2.2186E-01, | |
36510 | &1.6735E-01,1.1268E-01,5.7652E-02,0.0000E+00,3.2129E+00,3.1726E+00, | |
36511 | &3.1325E+00,3.0928E+00,3.0540E+00,3.0127E+00,2.9717E+00,2.9303E+00, | |
36512 | &2.8887E+00,2.8449E+00,2.8001E+00,2.7537E+00,2.7060E+00,2.6766E+00, | |
36513 | &2.6453E+00,2.6073E+00,2.5683E+00,2.5286E+00,2.4866E+00,2.4501E+00, | |
36514 | &2.4107E+00,2.3628E+00,2.3125E+00,2.2620E+00,2.2079E+00,2.1597E+00, | |
36515 | &2.1067E+00,2.0440E+00,1.9778E+00,1.9097E+00,1.8421E+00,1.7819E+00, | |
36516 | &1.7169E+00,1.6416E+00,1.5664E+00,1.4922E+00,1.4189E+00,1.3583E+00, | |
36517 | &1.2971E+00,1.2300E+00,1.1652E+00,1.1200E+00,1.0729E+00,1.0343E+00, | |
36518 | &9.9254E-01,9.5513E-01,9.2006E-01,8.8711E-01,8.5555E-01,8.2426E-01, | |
36519 | &7.9305E-01,7.6193E-01,7.2963E-01,6.9636E-01,6.6128E-01,6.3868E-01/ | |
36520 | DATA (XDVF_L(K),K= 1825, 1836) / | |
36521 | &5.8093E-01,5.2428E-01,4.6858E-01,4.1372E-01,3.5972E-01,3.0648E-01, | |
36522 | &2.5392E-01,2.0208E-01,1.5083E-01,1.0018E-01,5.0068E-02,0.0000E+00/ | |
36523 | DATA (XDEF_L(K),K= 1, 114) / | |
36524 | &4.3007E-01,4.2474E-01,4.1967E-01,4.1458E-01,4.0970E-01,4.0443E-01, | |
36525 | &3.9925E-01,3.9397E-01,3.8864E-01,3.8302E-01,3.7707E-01,3.7100E-01, | |
36526 | &3.6470E-01,3.6080E-01,3.5639E-01,3.5109E-01,3.4531E-01,3.3914E-01, | |
36527 | &3.3238E-01,3.2609E-01,3.1913E-01,3.1062E-01,3.0152E-01,2.9176E-01, | |
36528 | &2.8100E-01,2.7114E-01,2.5952E-01,2.4467E-01,2.2784E-01,2.0937E-01, | |
36529 | &1.9117E-01,1.7470E-01,1.5685E-01,1.3678E-01,1.1825E-01,1.0349E-01, | |
36530 | &9.4854E-02,9.5054E-02,1.0589E-01,1.3527E-01,1.8584E-01,2.3426E-01, | |
36531 | &2.9021E-01,3.3527E-01,3.7670E-01,4.0255E-01,4.1326E-01,4.0880E-01, | |
36532 | &3.8831E-01,3.5045E-01,2.9287E-01,2.1298E-01,1.0773E-01,0.0000E+00, | |
36533 | &0.0000E+00,2.0644E-01,1.5422E-01,1.0950E-01,7.3614E-02,4.6726E-02, | |
36534 | &2.7433E-02,1.4144E-02,6.5080E-03,2.4719E-03,0.0000E+00,0.0000E+00, | |
36535 | &0.0000E+00,0.0000E+00,4.4398E-01,4.3864E-01,4.3346E-01,4.2809E-01, | |
36536 | &4.2290E-01,4.1747E-01,4.1205E-01,4.0650E-01,4.0098E-01,3.9480E-01, | |
36537 | &3.8873E-01,3.8226E-01,3.7560E-01,3.7145E-01,3.6678E-01,3.6108E-01, | |
36538 | &3.5488E-01,3.4833E-01,3.4123E-01,3.3464E-01,3.2718E-01,3.1811E-01, | |
36539 | &3.0838E-01,2.9811E-01,2.8670E-01,2.7630E-01,2.6412E-01,2.4861E-01, | |
36540 | &2.3110E-01,2.1209E-01,1.9355E-01,1.7681E-01,1.5878E-01,1.3870E-01, | |
36541 | &1.2044E-01,1.0620E-01,9.8341E-02,9.9345E-02,1.1086E-01,1.4055E-01, | |
36542 | &1.9033E-01,2.3696E-01,2.8983E-01,3.3137E-01,3.6834E-01,3.8982E-01/ | |
36543 | DATA (XDEF_L(K),K= 115, 228) / | |
36544 | &3.9672E-01,3.8896E-01,3.6609E-01,3.2678E-01,2.6933E-01,1.9181E-01, | |
36545 | &9.1683E-02,0.0000E+00,0.0000E+00,1.8955E-01,1.4041E-01,9.8873E-02, | |
36546 | &6.5928E-02,4.1462E-02,2.3905E-02,1.2324E-02,5.6113E-03,2.1050E-03, | |
36547 | &0.0000E+00,0.0000E+00,0.0000E+00,0.0000E+00,4.5980E-01,4.5420E-01, | |
36548 | &4.4884E-01,4.4319E-01,4.3780E-01,4.3208E-01,4.2642E-01,4.2053E-01, | |
36549 | &4.1457E-01,4.0824E-01,4.0181E-01,3.9484E-01,3.8780E-01,3.8328E-01, | |
36550 | &3.7831E-01,3.7223E-01,3.6559E-01,3.5853E-01,3.5072E-01,3.4400E-01, | |
36551 | &3.3590E-01,3.2633E-01,3.1598E-01,3.0508E-01,2.9301E-01,2.8197E-01, | |
36552 | &2.6915E-01,2.5289E-01,2.3470E-01,2.1511E-01,1.9623E-01,1.7918E-01, | |
36553 | &1.6098E-01,1.4092E-01,1.2294E-01,1.0928E-01,1.0224E-01,1.0401E-01, | |
36554 | &1.1623E-01,1.4620E-01,1.9488E-01,2.3948E-01,2.8894E-01,3.2681E-01, | |
36555 | &3.5905E-01,3.7613E-01,3.7908E-01,3.6817E-01,3.4299E-01,3.0266E-01, | |
36556 | &2.4596E-01,1.7115E-01,7.6792E-02,0.0000E+00,0.0000E+00,1.7267E-01, | |
36557 | &1.2670E-01,8.8446E-02,5.8458E-02,3.6380E-02,2.0551E-02,1.0608E-02, | |
36558 | &4.7732E-03,1.7670E-03,0.0000E+00,0.0000E+00,0.0000E+00,0.0000E+00, | |
36559 | &4.7845E-01,4.7258E-01,4.6687E-01,4.6107E-01,4.5540E-01,4.4938E-01, | |
36560 | &4.4336E-01,4.3728E-01,4.3070E-01,4.2403E-01,4.1702E-01,4.0968E-01, | |
36561 | &4.0210E-01,3.9723E-01,3.9181E-01,3.8522E-01,3.7808E-01,3.7047E-01, | |
36562 | &3.6211E-01,3.5469E-01,3.4619E-01,3.3582E-01,3.2478E-01,3.1314E-01/ | |
36563 | DATA (XDEF_L(K),K= 229, 342) / | |
36564 | &3.0021E-01,2.8848E-01,2.7488E-01,2.5781E-01,2.3886E-01,2.1865E-01, | |
36565 | &1.9932E-01,1.8196E-01,1.6359E-01,1.4359E-01,1.2596E-01,1.1295E-01, | |
36566 | &1.0678E-01,1.0933E-01,1.2234E-01,1.5242E-01,1.9969E-01,2.4187E-01, | |
36567 | &2.8742E-01,3.2112E-01,3.4825E-01,3.6067E-01,3.5959E-01,3.4546E-01, | |
36568 | &3.1813E-01,2.7719E-01,2.2151E-01,1.5037E-01,6.2862E-02,0.0000E+00, | |
36569 | &0.0000E+00,1.5516E-01,1.1270E-01,7.7856E-02,5.0916E-02,3.1337E-02, | |
36570 | &1.7279E-02,8.9355E-03,3.9672E-03,1.4465E-03,0.0000E+00,0.0000E+00, | |
36571 | &0.0000E+00,0.0000E+00,5.0059E-01,4.9450E-01,4.8826E-01,4.8213E-01, | |
36572 | &4.7610E-01,4.6972E-01,4.6326E-01,4.5655E-01,4.4999E-01,4.4265E-01, | |
36573 | &4.3505E-01,4.2703E-01,4.1870E-01,4.1345E-01,4.0758E-01,4.0034E-01, | |
36574 | &3.9260E-01,3.8434E-01,3.7539E-01,3.6725E-01,3.5804E-01,3.4696E-01, | |
36575 | &3.3492E-01,3.2231E-01,3.0852E-01,2.9601E-01,2.8154E-01,2.6348E-01, | |
36576 | &2.4363E-01,2.2272E-01,2.0295E-01,1.8526E-01,1.6669E-01,1.4678E-01, | |
36577 | &1.2956E-01,1.1726E-01,1.1212E-01,1.1548E-01,1.2910E-01,1.5906E-01, | |
36578 | &2.0458E-01,2.4395E-01,2.8508E-01,3.1418E-01,3.3593E-01,3.4343E-01, | |
36579 | &3.3827E-01,3.2104E-01,2.9189E-01,2.5067E-01,1.9688E-01,1.3016E-01, | |
36580 | &5.0498E-02,0.0000E+00,0.0000E+00,1.3742E-01,9.8602E-02,6.7357E-02, | |
36581 | &4.3555E-02,2.6444E-02,1.4175E-02,7.3561E-03,3.2181E-03,1.1530E-03, | |
36582 | &0.0000E+00,0.0000E+00,0.0000E+00,0.0000E+00,5.2114E-01,5.1454E-01/ | |
36583 | DATA (XDEF_L(K),K= 343, 456) / | |
36584 | &5.0806E-01,5.0160E-01,4.9520E-01,4.8843E-01,4.8165E-01,4.7456E-01, | |
36585 | &4.6738E-01,4.5962E-01,4.5149E-01,4.4293E-01,4.3400E-01,4.2833E-01, | |
36586 | &4.2194E-01,4.1420E-01,4.0580E-01,3.9678E-01,3.8741E-01,3.7848E-01, | |
36587 | &3.6878E-01,3.5682E-01,3.4416E-01,3.3062E-01,3.1602E-01,3.0269E-01, | |
36588 | &2.8749E-01,2.6857E-01,2.4798E-01,2.2641E-01,2.0626E-01,1.8828E-01, | |
36589 | &1.6960E-01,1.4976E-01,1.3293E-01,1.2126E-01,1.1684E-01,1.2099E-01, | |
36590 | &1.3505E-01,1.6471E-01,2.0841E-01,2.4521E-01,2.8248E-01,3.0770E-01, | |
36591 | &3.2484E-01,3.2845E-01,3.1999E-01,3.0047E-01,2.7030E-01,2.2924E-01, | |
36592 | &1.7739E-01,1.1482E-01,4.2174E-02,0.0000E+00,0.0000E+00,1.2330E-01, | |
36593 | &8.7586E-02,5.9211E-02,3.7890E-02,2.2733E-02,1.1877E-02,6.1865E-03, | |
36594 | &2.6713E-03,9.4247E-04,0.0000E+00,0.0000E+00,0.0000E+00,0.0000E+00, | |
36595 | &5.4423E-01,5.3740E-01,5.3068E-01,5.2385E-01,5.1700E-01,5.0982E-01, | |
36596 | &5.0256E-01,4.9509E-01,4.8731E-01,4.7895E-01,4.7023E-01,4.6094E-01, | |
36597 | &4.5130E-01,4.4506E-01,4.3820E-01,4.2973E-01,4.2069E-01,4.1108E-01, | |
36598 | &4.0069E-01,3.9131E-01,3.8063E-01,3.6796E-01,3.5430E-01,3.3991E-01, | |
36599 | &3.2433E-01,3.1014E-01,2.9407E-01,2.7418E-01,2.5281E-01,2.3056E-01, | |
36600 | &2.0999E-01,1.9171E-01,1.7291E-01,1.5321E-01,1.3677E-01,1.2578E-01, | |
36601 | &1.2220E-01,1.2696E-01,1.4132E-01,1.7056E-01,2.1212E-01,2.4603E-01, | |
36602 | &2.7912E-01,3.0023E-01,3.1274E-01,3.1234E-01,3.0087E-01,2.7925E-01/ | |
36603 | DATA (XDEF_L(K),K= 457, 570) / | |
36604 | &2.4820E-01,2.0782E-01,1.5841E-01,1.0056E-01,3.5470E-02,0.0000E+00, | |
36605 | &0.0000E+00,1.0941E-01,7.6864E-02,5.1391E-02,3.2506E-02,1.9250E-02, | |
36606 | &9.7741E-03,5.1192E-03,2.1775E-03,0.0000E+00,0.0000E+00,0.0000E+00, | |
36607 | &0.0000E+00,0.0000E+00,5.6542E-01,5.5814E-01,5.5101E-01,5.4385E-01, | |
36608 | &5.3670E-01,5.2913E-01,5.2140E-01,5.1352E-01,5.0533E-01,4.9639E-01, | |
36609 | &4.8702E-01,4.7710E-01,4.6670E-01,4.6011E-01,4.5270E-01,4.4365E-01, | |
36610 | &4.3394E-01,4.2383E-01,4.1271E-01,4.0253E-01,3.9137E-01,3.7783E-01, | |
36611 | &3.6325E-01,3.4810E-01,3.3163E-01,3.1674E-01,2.9988E-01,2.7922E-01, | |
36612 | &2.5706E-01,2.3429E-01,2.1333E-01,1.9484E-01,1.7592E-01,1.5634E-01, | |
36613 | &1.4028E-01,1.2985E-01,1.2692E-01,1.3218E-01,1.4678E-01,1.7535E-01, | |
36614 | &2.1492E-01,2.4628E-01,2.7582E-01,2.9349E-01,3.0215E-01,2.9865E-01, | |
36615 | &2.8479E-01,2.6176E-01,2.3025E-01,1.9073E-01,1.4372E-01,9.0030E-02, | |
36616 | &3.1431E-02,0.0000E+00,0.0000E+00,9.8561E-02,6.8571E-02,4.5400E-02, | |
36617 | &2.8439E-02,1.6650E-02,8.2414E-03,4.3377E-03,1.8226E-03,0.0000E+00, | |
36618 | &0.0000E+00,0.0000E+00,0.0000E+00,0.0000E+00,5.8660E-01,5.7912E-01, | |
36619 | &5.7170E-01,5.6412E-01,5.5660E-01,5.4858E-01,5.4040E-01,5.3194E-01, | |
36620 | &5.2336E-01,5.1383E-01,5.0381E-01,4.9326E-01,4.8220E-01,4.7515E-01, | |
36621 | &4.6719E-01,4.5756E-01,4.4719E-01,4.3619E-01,4.2441E-01,4.1376E-01, | |
36622 | &4.0188E-01,3.8750E-01,3.7220E-01,3.5617E-01,3.3884E-01,3.2317E-01/ | |
36623 | DATA (XDEF_L(K),K= 571, 684) / | |
36624 | &3.0561E-01,2.8413E-01,2.6132E-01,2.3801E-01,2.1667E-01,1.9794E-01, | |
36625 | &1.7898E-01,1.5951E-01,1.4381E-01,1.3395E-01,1.3154E-01,1.3722E-01, | |
36626 | &1.5183E-01,1.7978E-01,2.1726E-01,2.4615E-01,2.7227E-01,2.8668E-01, | |
36627 | &2.9185E-01,2.8560E-01,2.6981E-01,2.4566E-01,2.1405E-01,1.7560E-01, | |
36628 | &1.3093E-01,8.1317E-02,2.8821E-02,0.0000E+00,0.0000E+00,8.9016E-02, | |
36629 | &6.1335E-02,4.0241E-02,2.4960E-02,1.4451E-02,6.9787E-03,3.6912E-03, | |
36630 | &1.5320E-03,0.0000E+00,0.0000E+00,0.0000E+00,0.0000E+00,0.0000E+00, | |
36631 | &6.0621E-01,5.9821E-01,5.9043E-01,5.8253E-01,5.7470E-01,5.6625E-01, | |
36632 | &5.5768E-01,5.4870E-01,5.3948E-01,5.2962E-01,5.1919E-01,5.0796E-01, | |
36633 | &4.9620E-01,4.8867E-01,4.8027E-01,4.7003E-01,4.5907E-01,4.4740E-01, | |
36634 | &4.3484E-01,4.2392E-01,4.1127E-01,3.9627E-01,3.8010E-01,3.6326E-01, | |
36635 | &3.4524E-01,3.2900E-01,3.1064E-01,2.8853E-01,2.6510E-01,2.4135E-01, | |
36636 | &2.1970E-01,2.0080E-01,1.8175E-01,1.6242E-01,1.4701E-01,1.3753E-01, | |
36637 | &1.3572E-01,1.4160E-01,1.5623E-01,1.8343E-01,2.1902E-01,2.4571E-01, | |
36638 | &2.6885E-01,2.8059E-01,2.8292E-01,2.7441E-01,2.5704E-01,2.3223E-01, | |
36639 | &2.0062E-01,1.6317E-01,1.2079E-01,7.4733E-02,2.7461E-02,0.0000E+00, | |
36640 | &0.0000E+00,8.1334E-02,5.5577E-02,3.6150E-02,2.2243E-02,1.2749E-02, | |
36641 | &6.0264E-03,3.2009E-03,1.3143E-03,0.0000E+00,0.0000E+00,0.0000E+00, | |
36642 | &0.0000E+00,0.0000E+00,6.2581E-01,6.1778E-01,6.0953E-01,6.0134E-01/ | |
36643 | DATA (XDEF_L(K),K= 685, 798) / | |
36644 | &5.9310E-01,5.8428E-01,5.7523E-01,5.6587E-01,5.5625E-01,5.4565E-01, | |
36645 | &5.3457E-01,5.2280E-01,5.1030E-01,5.0236E-01,4.9350E-01,4.8267E-01, | |
36646 | &4.7104E-01,4.5899E-01,4.4560E-01,4.3381E-01,4.2066E-01,4.0485E-01, | |
36647 | &3.8801E-01,3.7047E-01,3.5165E-01,3.3476E-01,3.1574E-01,2.9293E-01, | |
36648 | &2.6889E-01,2.4469E-01,2.2279E-01,2.0369E-01,1.8458E-01,1.6537E-01, | |
36649 | &1.5025E-01,1.4125E-01,1.3980E-01,1.4589E-01,1.6046E-01,1.8686E-01, | |
36650 | &2.2052E-01,2.4502E-01,2.6530E-01,2.7444E-01,2.7406E-01,2.6361E-01, | |
36651 | &2.4491E-01,2.1954E-01,1.8819E-01,1.5193E-01,1.1170E-01,6.9146E-02, | |
36652 | &2.6829E-02,0.0000E+00,0.0000E+00,7.4387E-02,5.0398E-02,3.2529E-02, | |
36653 | &1.9840E-02,1.1260E-02,5.2109E-03,2.7796E-03,1.1291E-03,0.0000E+00, | |
36654 | &0.0000E+00,0.0000E+00,0.0000E+00,0.0000E+00,6.4510E-01,6.3663E-01, | |
36655 | &6.2809E-01,6.1948E-01,6.1090E-01,6.0165E-01,5.9256E-01,5.8263E-01, | |
36656 | &5.7237E-01,5.6121E-01,5.4960E-01,5.3710E-01,5.2390E-01,5.1555E-01, | |
36657 | &5.0615E-01,4.9474E-01,4.8273E-01,4.6980E-01,4.5603E-01,4.4343E-01, | |
36658 | &4.2983E-01,4.1325E-01,3.9561E-01,3.7731E-01,3.5765E-01,3.4017E-01, | |
36659 | &3.2063E-01,2.9709E-01,2.7258E-01,2.4795E-01,2.2572E-01,2.0647E-01, | |
36660 | &1.8735E-01,1.6824E-01,1.5339E-01,1.4470E-01,1.4366E-01,1.4990E-01, | |
36661 | &1.6437E-01,1.8986E-01,2.2169E-01,2.4408E-01,2.6175E-01,2.6863E-01, | |
36662 | &2.6585E-01,2.5363E-01,2.3397E-01,2.0813E-01,1.7714E-01,1.4205E-01/ | |
36663 | DATA (XDEF_L(K),K= 799, 912) / | |
36664 | &1.0396E-01,6.4602E-02,2.6785E-02,0.0000E+00,0.0000E+00,6.8343E-02, | |
36665 | &4.5962E-02,2.9434E-02,1.7812E-02,1.0015E-02,4.5458E-03,2.4331E-03, | |
36666 | &9.7866E-04,0.0000E+00,0.0000E+00,0.0000E+00,0.0000E+00,0.0000E+00, | |
36667 | &6.6281E-01,6.5407E-01,6.4523E-01,6.3631E-01,6.2740E-01,6.1775E-01, | |
36668 | &6.0821E-01,5.9770E-01,5.8724E-01,5.7535E-01,5.6321E-01,5.5021E-01, | |
36669 | &5.3640E-01,5.2763E-01,5.1775E-01,5.0583E-01,4.9310E-01,4.7946E-01, | |
36670 | &4.6520E-01,4.5225E-01,4.3811E-01,4.2074E-01,4.0247E-01,3.8355E-01, | |
36671 | &3.6315E-01,3.4516E-01,3.2502E-01,3.0091E-01,2.7589E-01,2.5090E-01, | |
36672 | &2.2842E-01,2.0903E-01,1.8987E-01,1.7087E-01,1.5631E-01,1.4790E-01, | |
36673 | &1.4709E-01,1.5345E-01,1.6771E-01,1.9243E-01,2.2253E-01,2.4307E-01, | |
36674 | &2.5846E-01,2.6327E-01,2.5857E-01,2.4493E-01,2.2441E-01,1.9832E-01, | |
36675 | &1.6773E-01,1.3380E-01,9.7606E-02,6.1077E-02,2.7123E-02,4.1687E-04, | |
36676 | &0.0000E+00,6.3316E-02,4.2290E-02,2.6899E-02,1.6166E-02,9.0143E-03, | |
36677 | &4.0214E-03,2.1587E-03,8.6042E-04,0.0000E+00,0.0000E+00,0.0000E+00, | |
36678 | &0.0000E+00,0.0000E+00,6.8558E-01,6.7623E-01,6.6716E-01,6.5776E-01, | |
36679 | &6.4840E-01,6.3825E-01,6.2778E-01,6.1697E-01,6.0589E-01,5.9350E-01, | |
36680 | &5.8071E-01,5.6677E-01,5.5220E-01,5.4293E-01,5.3246E-01,5.1980E-01, | |
36681 | &5.0630E-01,4.9221E-01,4.7690E-01,4.6348E-01,4.4839E-01,4.3024E-01, | |
36682 | &4.1112E-01,3.9125E-01,3.7016E-01,3.5134E-01,3.3054E-01,3.0571E-01/ | |
36683 | DATA (XDEF_L(K),K= 913, 1026) / | |
36684 | &2.8005E-01,2.5463E-01,2.3186E-01,2.1230E-01,1.9311E-01,1.7422E-01, | |
36685 | &1.5985E-01,1.5187E-01,1.5138E-01,1.5783E-01,1.7178E-01,1.9543E-01, | |
36686 | &2.2331E-01,2.4162E-01,2.5415E-01,2.5666E-01,2.4964E-01,2.3438E-01, | |
36687 | &2.1293E-01,1.8681E-01,1.5680E-01,1.2430E-01,9.0488E-02,5.7352E-02, | |
36688 | &2.7942E-02,7.0995E-03,2.4780E-03,5.7612E-02,3.8138E-02,2.4057E-02, | |
36689 | &1.4329E-02,7.9111E-03,3.4566E-03,1.8603E-03,7.3347E-04,0.0000E+00, | |
36690 | &0.0000E+00,0.0000E+00,0.0000E+00,0.0000E+00,7.0709E-01,6.9744E-01, | |
36691 | &6.8784E-01,6.7803E-01,6.6830E-01,6.5763E-01,6.4678E-01,6.3540E-01, | |
36692 | &6.2360E-01,6.1071E-01,5.9715E-01,5.8240E-01,5.6710E-01,5.5722E-01, | |
36693 | &5.4625E-01,5.3291E-01,5.1856E-01,5.0380E-01,4.8797E-01,4.7363E-01, | |
36694 | &4.5801E-01,4.3900E-01,4.1917E-01,3.9846E-01,3.7656E-01,3.5717E-01, | |
36695 | &3.3564E-01,3.1017E-01,2.8397E-01,2.5816E-01,2.3508E-01,2.1538E-01, | |
36696 | &1.9615E-01,1.7737E-01,1.6324E-01,1.5559E-01,1.5535E-01,1.6175E-01, | |
36697 | &1.7537E-01,1.9793E-01,2.2384E-01,2.4005E-01,2.5009E-01,2.5051E-01, | |
36698 | &2.4150E-01,2.2495E-01,2.0291E-01,1.7668E-01,1.4739E-01,1.1625E-01, | |
36699 | &8.4583E-02,5.4470E-02,2.9013E-02,1.3147E-02,1.4553E-02,5.2777E-02, | |
36700 | &3.4672E-02,2.1686E-02,1.2821E-02,7.0105E-03,3.0093E-03,1.6226E-03, | |
36701 | &6.3321E-04,0.0000E+00,0.0000E+00,0.0000E+00,0.0000E+00,0.0000E+00, | |
36702 | &7.2796E-01,7.1795E-01,7.0799E-01,6.9776E-01,6.8760E-01,6.7649E-01/ | |
36703 | DATA (XDEF_L(K),K= 1027, 1140) / | |
36704 | &6.6523E-01,6.5299E-01,6.4099E-01,6.2720E-01,6.1289E-01,5.9763E-01, | |
36705 | &5.8140E-01,5.7108E-01,5.5954E-01,5.4555E-01,5.3082E-01,5.1501E-01, | |
36706 | &4.9841E-01,4.8352E-01,4.6718E-01,4.4758E-01,4.2678E-01,4.0543E-01, | |
36707 | &3.8267E-01,3.6267E-01,3.4052E-01,3.1445E-01,2.8771E-01,2.6154E-01, | |
36708 | &2.3817E-01,2.1835E-01,1.9910E-01,1.8043E-01,1.6662E-01,1.5905E-01, | |
36709 | &1.5900E-01,1.6548E-01,1.7871E-01,2.0015E-01,2.2403E-01,2.3835E-01, | |
36710 | &2.4610E-01,2.4469E-01,2.3394E-01,2.1634E-01,1.9372E-01,1.6761E-01, | |
36711 | &1.3910E-01,1.0920E-01,7.9530E-02,5.2165E-02,3.0250E-02,1.8723E-02, | |
36712 | &2.5275E-02,4.8575E-02,3.1676E-02,1.9677E-02,1.1540E-02,6.2533E-03, | |
36713 | &2.6411E-03,1.4253E-03,5.5072E-04,0.0000E+00,0.0000E+00,0.0000E+00, | |
36714 | &0.0000E+00,0.0000E+00,7.4788E-01,7.3751E-01,7.2708E-01,7.1644E-01, | |
36715 | &7.0580E-01,6.9430E-01,6.8256E-01,6.6975E-01,6.5712E-01,6.4276E-01, | |
36716 | &6.2791E-01,6.1180E-01,5.9490E-01,5.8409E-01,5.7199E-01,5.5739E-01, | |
36717 | &5.4166E-01,5.2544E-01,5.0821E-01,4.9288E-01,4.7590E-01,4.5544E-01, | |
36718 | &4.3393E-01,4.1178E-01,3.8837E-01,3.6775E-01,3.4513E-01,3.1844E-01, | |
36719 | &2.9125E-01,2.6472E-01,2.4110E-01,2.2115E-01,2.0189E-01,1.8330E-01, | |
36720 | &1.6955E-01,1.6237E-01,1.6243E-01,1.6875E-01,1.8164E-01,2.0201E-01, | |
36721 | &2.2410E-01,2.3665E-01,2.4236E-01,2.3927E-01,2.2710E-01,2.0852E-01, | |
36722 | &1.8563E-01,1.5962E-01,1.3170E-01,1.0314E-01,7.5292E-02,5.0347E-02/ | |
36723 | DATA (XDEF_L(K),K= 1141, 1254) / | |
36724 | &3.1513E-02,2.3688E-02,3.4520E-02,4.4988E-02,2.9140E-02,1.7975E-02, | |
36725 | &1.0472E-02,5.6268E-03,2.3442E-03,1.2646E-03,4.8432E-04,0.0000E+00, | |
36726 | &0.0000E+00,0.0000E+00,0.0000E+00,0.0000E+00,7.6812E-01,7.5731E-01, | |
36727 | &7.4653E-01,7.3551E-01,7.2440E-01,7.1234E-01,6.9989E-01,6.8692E-01, | |
36728 | &6.7357E-01,6.5855E-01,6.4312E-01,6.2624E-01,6.0850E-01,5.9719E-01, | |
36729 | &5.8457E-01,5.6934E-01,5.5297E-01,5.3626E-01,5.1802E-01,5.0223E-01, | |
36730 | &4.8440E-01,4.6329E-01,4.4109E-01,4.1826E-01,3.9408E-01,3.7291E-01, | |
36731 | &3.4966E-01,3.2243E-01,2.9475E-01,2.6790E-01,2.4406E-01,2.2399E-01, | |
36732 | &2.0470E-01,1.8621E-01,1.7262E-01,1.6558E-01,1.6576E-01,1.7201E-01, | |
36733 | &1.8441E-01,2.0372E-01,2.2403E-01,2.3482E-01,2.3856E-01,2.3398E-01, | |
36734 | &2.2040E-01,2.0103E-01,1.7782E-01,1.5205E-01,1.2492E-01,9.7540E-02, | |
36735 | &7.1452E-02,4.8817E-02,3.2832E-02,2.8412E-02,4.3068E-02,4.1684E-02, | |
36736 | &2.6819E-02,1.6431E-02,9.5049E-03,5.0674E-03,2.0840E-03,1.1231E-03, | |
36737 | &4.2643E-04,0.0000E+00,0.0000E+00,0.0000E+00,0.0000E+00,0.0000E+00, | |
36738 | &7.8709E-01,7.7617E-01,7.6509E-01,7.5353E-01,7.4210E-01,7.2955E-01, | |
36739 | &7.1666E-01,7.0326E-01,6.8906E-01,6.7364E-01,6.5743E-01,6.3988E-01, | |
36740 | &6.2140E-01,6.0962E-01,5.9645E-01,5.8083E-01,5.6382E-01,5.4630E-01, | |
36741 | &5.2750E-01,5.1079E-01,4.9267E-01,4.7078E-01,4.4780E-01,4.2425E-01, | |
36742 | &3.9948E-01,3.7773E-01,3.5398E-01,3.2619E-01,2.9811E-01,2.7093E-01/ | |
36743 | DATA (XDEF_L(K),K= 1255, 1368) / | |
36744 | &2.4686E-01,2.2668E-01,2.0735E-01,1.8888E-01,1.7555E-01,1.6865E-01, | |
36745 | &1.6887E-01,1.7500E-01,1.8693E-01,2.0522E-01,2.2377E-01,2.3300E-01, | |
36746 | &2.3501E-01,2.2902E-01,2.1428E-01,1.9427E-01,1.7084E-01,1.4533E-01, | |
36747 | &1.1889E-01,9.2655E-02,6.8174E-02,4.7575E-02,3.4123E-02,3.2605E-02, | |
36748 | &5.0454E-02,3.8820E-02,2.4822E-02,1.5113E-02,8.6857E-03,4.5962E-03, | |
36749 | &1.8704E-03,1.0050E-03,3.7856E-04,0.0000E+00,0.0000E+00,0.0000E+00, | |
36750 | &0.0000E+00,0.0000E+00,8.0606E-01,7.9455E-01,7.8312E-01,7.7128E-01, | |
36751 | &7.5940E-01,7.4610E-01,7.3287E-01,7.1917E-01,7.0456E-01,6.8825E-01, | |
36752 | &6.7140E-01,6.5313E-01,6.3390E-01,6.2170E-01,6.0798E-01,5.9180E-01, | |
36753 | &5.7419E-01,5.5596E-01,5.3636E-01,5.1934E-01,5.0050E-01,4.7790E-01, | |
36754 | &4.5436E-01,4.3012E-01,4.0458E-01,3.8238E-01,3.5808E-01,3.2984E-01, | |
36755 | &3.0133E-01,2.7388E-01,2.4957E-01,2.2930E-01,2.0996E-01,1.9168E-01, | |
36756 | &1.7832E-01,1.7159E-01,1.7177E-01,1.7770E-01,1.8921E-01,2.0651E-01, | |
36757 | &2.2344E-01,2.3117E-01,2.3152E-01,2.2426E-01,2.0844E-01,1.8790E-01, | |
36758 | &1.6440E-01,1.3914E-01,1.1342E-01,8.8280E-02,6.5276E-02,4.6578E-02, | |
36759 | &3.5360E-02,3.6411E-02,5.6986E-02,3.6256E-02,2.3040E-02,1.3948E-02, | |
36760 | &7.9676E-03,4.1856E-03,1.6876E-03,9.0394E-04,3.3789E-04,0.0000E+00, | |
36761 | &0.0000E+00,0.0000E+00,0.0000E+00,0.0000E+00,8.2409E-01,8.1223E-01, | |
36762 | &8.0027E-01,7.8810E-01,7.7580E-01,7.6250E-01,7.4852E-01,7.3383E-01/ | |
36763 | DATA (XDEF_L(K),K= 1369, 1482) / | |
36764 | &7.1879E-01,7.0216E-01,6.8466E-01,6.6571E-01,6.4580E-01,6.3303E-01, | |
36765 | &6.1887E-01,6.0161E-01,5.8362E-01,5.6485E-01,5.4490E-01,5.2736E-01, | |
36766 | &5.0788E-01,4.8465E-01,4.6048E-01,4.3549E-01,4.0949E-01,3.8678E-01, | |
36767 | &3.6198E-01,3.3325E-01,3.0435E-01,2.7667E-01,2.5212E-01,2.3179E-01, | |
36768 | &2.1241E-01,1.9410E-01,1.8093E-01,1.7428E-01,1.7445E-01,1.8022E-01, | |
36769 | &1.9133E-01,2.0758E-01,2.2299E-01,2.2941E-01,2.2823E-01,2.1990E-01, | |
36770 | &2.0319E-01,1.8211E-01,1.5852E-01,1.3371E-01,1.0856E-01,8.4430E-02, | |
36771 | &6.2776E-02,4.5758E-02,3.6514E-02,3.9756E-02,6.2597E-02,3.4019E-02, | |
36772 | &2.1502E-02,1.2943E-02,7.3506E-03,3.8366E-03,1.5351E-03,8.1923E-04, | |
36773 | &3.0383E-04,0.0000E+00,0.0000E+00,0.0000E+00,0.0000E+00,0.0000E+00, | |
36774 | &8.4844E-01,8.3627E-01,8.2378E-01,8.1114E-01,7.9820E-01,7.8411E-01, | |
36775 | &7.6977E-01,7.5436E-01,7.3871E-01,7.2101E-01,7.0269E-01,6.8280E-01, | |
36776 | &6.6180E-01,6.4849E-01,6.3365E-01,6.1605E-01,5.9682E-01,5.7721E-01, | |
36777 | &5.5628E-01,5.3805E-01,5.1772E-01,4.9378E-01,4.6868E-01,4.4295E-01, | |
36778 | &4.1599E-01,3.9262E-01,3.6722E-01,3.3788E-01,3.0847E-01,2.8040E-01, | |
36779 | &2.5562E-01,2.3513E-01,2.1572E-01,1.9746E-01,1.8447E-01,1.7787E-01, | |
36780 | &1.7810E-01,1.8358E-01,1.9394E-01,2.0894E-01,2.2227E-01,2.2689E-01, | |
36781 | &2.2385E-01,2.1408E-01,1.9620E-01,1.7461E-01,1.5108E-01,1.2667E-01, | |
36782 | &1.0243E-01,7.9635E-02,5.9715E-02,4.4804E-02,3.7997E-02,4.3894E-02/ | |
36783 | DATA (XDEF_L(K),K= 1483, 1596) / | |
36784 | &6.9391E-02,3.1240E-02,1.9603E-02,1.1712E-02,6.6036E-03,3.4150E-03, | |
36785 | &1.3549E-03,7.1812E-04,2.6373E-04,0.0000E+00,0.0000E+00,0.0000E+00, | |
36786 | &0.0000E+00,0.0000E+00,8.7089E-01,8.5819E-01,8.4535E-01,8.3207E-01, | |
36787 | &8.1860E-01,8.0424E-01,7.8877E-01,7.7320E-01,7.5642E-01,7.3822E-01, | |
36788 | &7.1895E-01,6.9816E-01,6.7640E-01,6.6244E-01,6.4701E-01,6.2817E-01, | |
36789 | &6.0860E-01,5.8841E-01,5.6672E-01,5.4767E-01,5.2667E-01,5.0182E-01, | |
36790 | &4.7599E-01,4.4955E-01,4.2190E-01,3.9787E-01,3.7196E-01,3.4199E-01, | |
36791 | &3.1220E-01,2.8382E-01,2.5874E-01,2.3816E-01,2.1874E-01,2.0063E-01, | |
36792 | &1.8770E-01,1.8107E-01,1.8121E-01,1.8638E-01,1.9622E-01,2.0994E-01, | |
36793 | &2.2156E-01,2.2456E-01,2.1986E-01,2.0892E-01,1.9015E-01,1.6817E-01, | |
36794 | &1.4465E-01,1.2070E-01,9.7309E-02,7.5665E-02,5.7234E-02,4.4095E-02, | |
36795 | &3.9289E-02,4.7307E-02,7.4739E-02,2.8958E-02,1.8046E-02,1.0716E-02, | |
36796 | &6.0010E-03,3.0801E-03,1.2145E-03,6.3833E-04,2.3251E-04,0.0000E+00, | |
36797 | &0.0000E+00,0.0000E+00,0.0000E+00,0.0000E+00,8.9366E-01,8.8058E-01, | |
36798 | &8.6727E-01,8.5353E-01,8.3950E-01,8.2436E-01,8.0890E-01,7.9205E-01, | |
36799 | &7.7476E-01,7.5566E-01,7.3557E-01,7.1393E-01,6.9120E-01,6.7672E-01, | |
36800 | &6.6059E-01,6.4145E-01,6.2086E-01,5.9962E-01,5.7716E-01,5.5756E-01, | |
36801 | &5.3584E-01,5.1022E-01,4.8344E-01,4.5615E-01,4.2780E-01,4.0320E-01, | |
36802 | &3.7671E-01,3.4621E-01,3.1594E-01,2.8727E-01,2.6196E-01,2.4126E-01/ | |
36803 | DATA (XDEF_L(K),K= 1597, 1710) / | |
36804 | &2.2177E-01,2.0361E-01,1.9078E-01,1.8427E-01,1.8432E-01,1.8918E-01, | |
36805 | &1.9834E-01,2.1079E-01,2.2065E-01,2.2210E-01,2.1587E-01,2.0383E-01, | |
36806 | &1.8424E-01,1.6197E-01,1.3849E-01,1.1505E-01,9.2463E-02,7.1949E-02, | |
36807 | &5.4952E-02,4.3474E-02,4.0525E-02,5.0376E-02,7.9517E-02,2.6835E-02, | |
36808 | &1.6616E-02,9.8004E-03,5.4489E-03,2.7768E-03,1.0900E-03,5.6728E-04, | |
36809 | &2.0489E-04,0.0000E+00,0.0000E+00,0.0000E+00,0.0000E+00,0.0000E+00, | |
36810 | &9.1643E-01,9.0298E-01,8.8901E-01,8.7472E-01,8.6030E-01,8.4449E-01, | |
36811 | &8.2790E-01,8.1090E-01,7.9278E-01,7.7287E-01,7.5201E-01,7.2942E-01, | |
36812 | &7.0580E-01,6.9067E-01,6.7395E-01,6.5357E-01,6.3264E-01,6.1082E-01, | |
36813 | &5.8728E-01,5.6718E-01,5.4478E-01,5.1825E-01,4.9075E-01,4.6263E-01, | |
36814 | &4.3360E-01,4.0844E-01,3.8138E-01,3.5032E-01,3.1963E-01,2.9065E-01, | |
36815 | &2.6511E-01,2.4428E-01,2.2479E-01,2.0678E-01,1.9385E-01,1.8735E-01, | |
36816 | &1.8722E-01,1.9179E-01,2.0029E-01,2.1158E-01,2.1961E-01,2.1971E-01, | |
36817 | &2.1194E-01,1.9894E-01,1.7862E-01,1.5609E-01,1.3279E-01,1.0972E-01, | |
36818 | &8.8007E-02,6.8578E-02,5.2905E-02,4.2942E-02,4.1624E-02,5.3065E-02, | |
36819 | &8.3506E-02,2.4920E-02,1.5334E-02,8.9876E-03,4.9653E-03,2.5112E-03, | |
36820 | &9.8300E-04,5.0629E-04,0.0000E+00,0.0000E+00,0.0000E+00,0.0000E+00, | |
36821 | &0.0000E+00,0.0000E+00,9.3762E-01,9.2325E-01,9.0916E-01,8.9432E-01, | |
36822 | &8.7930E-01,8.6312E-01,8.4579E-01,8.2807E-01,8.0954E-01,7.8866E-01/ | |
36823 | DATA (XDEF_L(K),K= 1711, 1824) / | |
36824 | &7.6704E-01,7.4360E-01,7.1911E-01,7.0343E-01,6.8612E-01,6.6512E-01, | |
36825 | &6.4349E-01,6.2048E-01,5.9676E-01,5.7574E-01,5.5261E-01,5.2556E-01, | |
36826 | &4.9731E-01,4.6862E-01,4.3881E-01,4.1318E-01,3.8556E-01,3.5408E-01, | |
36827 | &3.2299E-01,2.9375E-01,2.6794E-01,2.4706E-01,2.2744E-01,2.0939E-01, | |
36828 | &1.9662E-01,1.9016E-01,1.8990E-01,1.9412E-01,2.0192E-01,2.1208E-01, | |
36829 | &2.1863E-01,2.1745E-01,2.0845E-01,1.9458E-01,1.7365E-01,1.5094E-01, | |
36830 | &1.2783E-01,1.0526E-01,8.4228E-02,6.5746E-02,5.1203E-02,4.2521E-02, | |
36831 | &4.2531E-02,5.5238E-02,8.6619E-02,2.3321E-02,1.4266E-02,8.3142E-03, | |
36832 | &4.5684E-03,2.2945E-03,8.9721E-04,4.5700E-04,0.0000E+00,0.0000E+00, | |
36833 | &0.0000E+00,0.0000E+00,0.0000E+00,0.0000E+00,9.5912E-01,9.4446E-01, | |
36834 | &9.2967E-01,9.1446E-01,8.9890E-01,8.8176E-01,8.6424E-01,8.4567E-01, | |
36835 | &8.2630E-01,8.0492E-01,7.8242E-01,7.5817E-01,7.3271E-01,7.1653E-01, | |
36836 | &6.9849E-01,6.7725E-01,6.5433E-01,6.3091E-01,6.0625E-01,5.8456E-01, | |
36837 | &5.6088E-01,5.3305E-01,5.0402E-01,4.7461E-01,4.4411E-01,4.1800E-01, | |
36838 | &3.8988E-01,3.5790E-01,3.2644E-01,2.9690E-01,2.7087E-01,2.4987E-01, | |
36839 | &2.3039E-01,2.1219E-01,1.9955E-01,1.9298E-01,1.9248E-01,1.9636E-01, | |
36840 | &2.0355E-01,2.1258E-01,2.1752E-01,2.1512E-01,2.0490E-01,1.9021E-01, | |
36841 | &1.6876E-01,1.4586E-01,1.2296E-01,1.0090E-01,8.0587E-02,6.3034E-02, | |
36842 | &4.9591E-02,4.2122E-02,4.3355E-02,5.7203E-02,8.9336E-02,2.1802E-02/ | |
36843 | DATA (XDEF_L(K),K= 1825, 1836) / | |
36844 | &1.3258E-02,7.6843E-03,4.1967E-03,2.0952E-03,8.1932E-04,4.1202E-04, | |
36845 | &0.0000E+00,0.0000E+00,0.0000E+00,0.0000E+00,0.0000E+00,0.0000E+00/ | |
36846 | DATA (XUDF_L(K),K= 1, 114) / | |
36847 | &1.8987E-02,1.9947E-02,2.0980E-02,2.2068E-02,2.3225E-02,2.4540E-02, | |
36848 | &2.5957E-02,2.7526E-02,2.9229E-02,3.1232E-02,3.3453E-02,3.6003E-02, | |
36849 | &3.8855E-02,4.0763E-02,4.2980E-02,4.5778E-02,4.8895E-02,5.2320E-02, | |
36850 | &5.6174E-02,5.9765E-02,6.3980E-02,6.9315E-02,7.5299E-02,8.1888E-02, | |
36851 | &8.9292E-02,9.6162E-02,1.0414E-01,1.1410E-01,1.2505E-01,1.3674E-01, | |
36852 | &1.4937E-01,1.6060E-01,1.7296E-01,1.8730E-01,2.0166E-01,2.1531E-01, | |
36853 | &2.2821E-01,2.3833E-01,2.4848E-01,2.6049E-01,2.7586E-01,2.9166E-01, | |
36854 | &3.1456E-01,3.3942E-01,3.7230E-01,4.0597E-01,4.3921E-01,4.7071E-01, | |
36855 | &4.9846E-01,5.2057E-01,5.3433E-01,5.3610E-01,5.2141E-01,4.8433E-01, | |
36856 | &4.1719E-01,6.3794E-01,6.7411E-01,7.2040E-01,7.8812E-01,8.9495E-01, | |
36857 | &1.0702E+00,1.3629E+00,1.8763E+00,2.8399E+00,4.8968E+00,1.0506E+01, | |
36858 | &3.7793E+01,0.0000E+00,3.1111E-02,3.2336E-02,3.3580E-02,3.4906E-02, | |
36859 | &3.6247E-02,3.7773E-02,3.9337E-02,4.1056E-02,4.2876E-02,4.5001E-02, | |
36860 | &4.7299E-02,4.9897E-02,5.2761E-02,5.4666E-02,5.6867E-02,5.9620E-02, | |
36861 | &6.2679E-02,6.6018E-02,6.9775E-02,7.3275E-02,7.7353E-02,8.2522E-02, | |
36862 | &8.8327E-02,9.4694E-02,1.0184E-01,1.0846E-01,1.1615E-01,1.2575E-01, | |
36863 | &1.3628E-01,1.4752E-01,1.5964E-01,1.7036E-01,1.8215E-01,1.9580E-01, | |
36864 | &2.0933E-01,2.2213E-01,2.3411E-01,2.4341E-01,2.5275E-01,2.6387E-01, | |
36865 | &2.7831E-01,2.9333E-01,3.1510E-01,3.3876E-01,3.6995E-01,4.0170E-01/ | |
36866 | DATA (XUDF_L(K),K= 115, 228) / | |
36867 | &4.3298E-01,4.6172E-01,4.8742E-01,5.0700E-01,5.1856E-01,5.1873E-01, | |
36868 | &5.0352E-01,4.6746E-01,4.0418E-01,6.1801E-01,6.5339E-01,6.9923E-01, | |
36869 | &7.6627E-01,8.7125E-01,1.0408E+00,1.3199E+00,1.8020E+00,2.6920E+00, | |
36870 | &4.5574E+00,9.5310E+00,3.2877E+01,0.0000E+00,5.1176E-02,5.2640E-02, | |
36871 | &5.4100E-02,5.5603E-02,5.7095E-02,5.8737E-02,6.0416E-02,6.2154E-02, | |
36872 | &6.4016E-02,6.6046E-02,6.8273E-02,7.0765E-02,7.3444E-02,7.5182E-02, | |
36873 | &7.7263E-02,7.9781E-02,8.2626E-02,8.5707E-02,8.9176E-02,9.2402E-02, | |
36874 | &9.6182E-02,1.0098E-01,1.0635E-01,1.1227E-01,1.1893E-01,1.2513E-01, | |
36875 | &1.3230E-01,1.4128E-01,1.5115E-01,1.6164E-01,1.7300E-01,1.8301E-01, | |
36876 | &1.9397E-01,2.0660E-01,2.1907E-01,2.3072E-01,2.4154E-01,2.4985E-01, | |
36877 | &2.5817E-01,2.6810E-01,2.8136E-01,2.9535E-01,3.1585E-01,3.3824E-01, | |
36878 | &3.6743E-01,3.9701E-01,4.2565E-01,4.5205E-01,4.7460E-01,4.9184E-01, | |
36879 | &5.0110E-01,4.9954E-01,4.8363E-01,4.4878E-01,3.8940E-01,5.9452E-01, | |
36880 | &6.2820E-01,6.7181E-01,7.3612E-01,8.3598E-01,9.9560E-01,1.2543E+00, | |
36881 | &1.6953E+00,2.4947E+00,4.1415E+00,8.4275E+00,2.7797E+01,0.0000E+00, | |
36882 | &8.6266E-02,8.7847E-02,8.9380E-02,9.0869E-02,9.2337E-02,9.3826E-02, | |
36883 | &9.5315E-02,9.6842E-02,9.8333E-02,1.0003E-01,1.0178E-01,1.0370E-01, | |
36884 | &1.0575E-01,1.0710E-01,1.0872E-01,1.1075E-01,1.1295E-01,1.1538E-01, | |
36885 | &1.1821E-01,1.2088E-01,1.2396E-01,1.2796E-01,1.3252E-01,1.3756E-01/ | |
36886 | DATA (XUDF_L(K),K= 229, 342) / | |
36887 | &1.4331E-01,1.4870E-01,1.5500E-01,1.6291E-01,1.7166E-01,1.8100E-01, | |
36888 | &1.9111E-01,2.0002E-01,2.0977E-01,2.2095E-01,2.3189E-01,2.4200E-01, | |
36889 | &2.5123E-01,2.5821E-01,2.6512E-01,2.7351E-01,2.8514E-01,2.9789E-01, | |
36890 | &3.1683E-01,3.3731E-01,3.6424E-01,3.9124E-01,4.1697E-01,4.4030E-01, | |
36891 | &4.6002E-01,4.7419E-01,4.8085E-01,4.7740E-01,4.6086E-01,4.2728E-01, | |
36892 | &3.7241E-01,5.6656E-01,5.9684E-01,6.3694E-01,6.9622E-01,7.8804E-01, | |
36893 | &9.3343E-01,1.1653E+00,1.5545E+00,2.2504E+00,3.6537E+00,7.2124E+00, | |
36894 | &2.2653E+01,0.0000E+00,1.4838E-01,1.4960E-01,1.5068E-01,1.5161E-01, | |
36895 | &1.5242E-01,1.5316E-01,1.5373E-01,1.5426E-01,1.5470E-01,1.5511E-01, | |
36896 | &1.5554E-01,1.5602E-01,1.5660E-01,1.5698E-01,1.5750E-01,1.5830E-01, | |
36897 | &1.5923E-01,1.6034E-01,1.6181E-01,1.6324E-01,1.6509E-01,1.6746E-01, | |
36898 | &1.7054E-01,1.7402E-01,1.7811E-01,1.8208E-01,1.8687E-01,1.9296E-01, | |
36899 | &1.9986E-01,2.0734E-01,2.1554E-01,2.2281E-01,2.3075E-01,2.3983E-01, | |
36900 | &2.4863E-01,2.5660E-01,2.6366E-01,2.6883E-01,2.7387E-01,2.8026E-01, | |
36901 | &2.8982E-01,3.0088E-01,3.1780E-01,3.3626E-01,3.6021E-01,3.8399E-01, | |
36902 | &4.0666E-01,4.2682E-01,4.4278E-01,4.5386E-01,4.5774E-01,4.5230E-01, | |
36903 | &4.3509E-01,4.0314E-01,3.5321E-01,5.3325E-01,5.5916E-01,5.9448E-01, | |
36904 | &6.4707E-01,7.2797E-01,8.5557E-01,1.0563E+00,1.3882E+00,1.9717E+00, | |
36905 | &3.1223E+00,5.9601E+00,1.7750E+01,0.0000E+00,2.3139E-01,2.3138E-01/ | |
36906 | DATA (XUDF_L(K),K= 343, 456) / | |
36907 | &2.3120E-01,2.3076E-01,2.3006E-01,2.2907E-01,2.2788E-01,2.2645E-01, | |
36908 | &2.2489E-01,2.2308E-01,2.2120E-01,2.1929E-01,2.1743E-01,2.1630E-01, | |
36909 | &2.1526E-01,2.1411E-01,2.1311E-01,2.1231E-01,2.1171E-01,2.1148E-01, | |
36910 | &2.1150E-01,2.1182E-01,2.1271E-01,2.1412E-01,2.1601E-01,2.1822E-01, | |
36911 | &2.2096E-01,2.2496E-01,2.2961E-01,2.3481E-01,2.4086E-01,2.4622E-01, | |
36912 | &2.5214E-01,2.5891E-01,2.6537E-01,2.7104E-01,2.7588E-01,2.7922E-01, | |
36913 | &2.8235E-01,2.8664E-01,2.9413E-01,3.0352E-01,3.1845E-01,3.3481E-01, | |
36914 | &3.5617E-01,3.7737E-01,3.9689E-01,4.1403E-01,4.2736E-01,4.3558E-01, | |
36915 | &4.3712E-01,4.3016E-01,4.1245E-01,3.8197E-01,3.3645E-01,5.0322E-01, | |
36916 | &5.2507E-01,5.5559E-01,6.0172E-01,6.7286E-01,7.8413E-01,9.5797E-01, | |
36917 | &1.2422E+00,1.7341E+00,2.6883E+00,4.9868E+00,1.4177E+01,0.0000E+00, | |
36918 | &3.6389E-01,3.6098E-01,3.5780E-01,3.5400E-01,3.5016E-01,3.4553E-01, | |
36919 | &3.4044E-01,3.3521E-01,3.2971E-01,3.2369E-01,3.1755E-01,3.1120E-01, | |
36920 | &3.0494E-01,3.0120E-01,2.9724E-01,2.9287E-01,2.8855E-01,2.8449E-01, | |
36921 | &2.8072E-01,2.7770E-01,2.7469E-01,2.7175E-01,2.6933E-01,2.6740E-01, | |
36922 | &2.6613E-01,2.6556E-01,2.6563E-01,2.6631E-01,2.6763E-01,2.6975E-01, | |
36923 | &2.7268E-01,2.7539E-01,2.7857E-01,2.8224E-01,2.8565E-01,2.8841E-01, | |
36924 | &2.9040E-01,2.9139E-01,2.9220E-01,2.9395E-01,2.9888E-01,3.0633E-01, | |
36925 | &3.1877E-01,3.3296E-01,3.5147E-01,3.6947E-01,3.8604E-01,3.9986E-01/ | |
36926 | DATA (XUDF_L(K),K= 457, 570) / | |
36927 | &4.1008E-01,4.1548E-01,4.1467E-01,4.0620E-01,3.8830E-01,3.5965E-01, | |
36928 | &3.1902E-01,4.7020E-01,4.8772E-01,5.1303E-01,5.5185E-01,6.1224E-01, | |
36929 | &7.0699E-01,8.5323E-01,1.0903E+00,1.4950E+00,2.2640E+00,4.0723E+00, | |
36930 | &0.0000E+00,0.0000E+00,5.2666E-01,5.1909E-01,5.1100E-01,5.0238E-01, | |
36931 | &4.9333E-01,4.8312E-01,4.7293E-01,4.6180E-01,4.5066E-01,4.3890E-01, | |
36932 | &4.2692E-01,4.1467E-01,4.0262E-01,3.9542E-01,3.8784E-01,3.7925E-01, | |
36933 | &3.7080E-01,3.6267E-01,3.5482E-01,3.4841E-01,3.4190E-01,3.3492E-01, | |
36934 | &3.2852E-01,3.2287E-01,3.1768E-01,3.1409E-01,3.1066E-01,3.0785E-01, | |
36935 | &3.0564E-01,3.0446E-01,3.0380E-01,3.0388E-01,3.0402E-01,3.0458E-01, | |
36936 | &3.0488E-01,3.0475E-01,3.0386E-01,3.0263E-01,3.0116E-01,3.0045E-01, | |
36937 | &3.0296E-01,3.0852E-01,3.1888E-01,3.3085E-01,3.4677E-01,3.6222E-01, | |
36938 | &3.7600E-01,3.8707E-01,3.9488E-01,3.9799E-01,3.9530E-01,3.8568E-01, | |
36939 | &3.6791E-01,3.4080E-01,3.0424E-01,4.4195E-01,4.5570E-01,4.7648E-01, | |
36940 | &5.0935E-01,5.6099E-01,6.4225E-01,7.6680E-01,9.6736E-01,1.3053E+00, | |
36941 | &1.9393E+00,3.3976E+00,0.0000E+00,0.0000E+00,7.4015E-01,7.2498E-01, | |
36942 | &7.0940E-01,6.9297E-01,6.7620E-01,6.5800E-01,6.3935E-01,6.2047E-01, | |
36943 | &6.0114E-01,5.8076E-01,5.6065E-01,5.4030E-01,5.2035E-01,5.0839E-01, | |
36944 | &4.9583E-01,4.8167E-01,4.6773E-01,4.5434E-01,4.4113E-01,4.3035E-01, | |
36945 | &4.1922E-01,4.0719E-01,3.9582E-01,3.8536E-01,3.7557E-01,3.6805E-01/ | |
36946 | DATA (XUDF_L(K),K= 571, 684) / | |
36947 | &3.6079E-01,3.5336E-01,3.4710E-01,3.4173E-01,3.3719E-01,3.3400E-01, | |
36948 | &3.3124E-01,3.2819E-01,3.2494E-01,3.2158E-01,3.1765E-01,3.1400E-01, | |
36949 | &3.1011E-01,3.0684E-01,3.0682E-01,3.1046E-01,3.1856E-01,3.2861E-01, | |
36950 | &3.4189E-01,3.5475E-01,3.6597E-01,3.7463E-01,3.8003E-01,3.8108E-01, | |
36951 | &3.7681E-01,3.6631E-01,3.4865E-01,3.2327E-01,2.9078E-01,4.1488E-01, | |
36952 | &4.2529E-01,4.4193E-01,4.6945E-01,5.1322E-01,5.8236E-01,6.8846E-01, | |
36953 | &8.5739E-01,1.1394E+00,1.6617E+00,2.8395E+00,0.0000E+00,0.0000E+00, | |
36954 | &9.8501E-01,9.5975E-01,9.3420E-01,9.0757E-01,8.8092E-01,8.5237E-01, | |
36955 | &8.2383E-01,7.9445E-01,7.6556E-01,7.3524E-01,7.0484E-01,6.7495E-01, | |
36956 | &6.4547E-01,6.2798E-01,6.0969E-01,5.8904E-01,5.6882E-01,5.4932E-01, | |
36957 | &5.3014E-01,5.1443E-01,4.9826E-01,4.8058E-01,4.6380E-01,4.4815E-01, | |
36958 | &4.3330E-01,4.2167E-01,4.1020E-01,3.9827E-01,3.8748E-01,3.7784E-01, | |
36959 | &3.6931E-01,3.6303E-01,3.5669E-01,3.4992E-01,3.4358E-01,3.3710E-01, | |
36960 | &3.3025E-01,3.2429E-01,3.1817E-01,3.1242E-01,3.1001E-01,3.1195E-01, | |
36961 | &3.1802E-01,3.2610E-01,3.3719E-01,3.4770E-01,3.5674E-01,3.6357E-01, | |
36962 | &3.6695E-01,3.6631E-01,3.6075E-01,3.4960E-01,3.3214E-01,3.0855E-01, | |
36963 | &2.7931E-01,3.9198E-01,3.9931E-01,4.1263E-01,4.3550E-01,4.7310E-01, | |
36964 | &5.3259E-01,6.2375E-01,7.6876E-01,1.0087E+00,1.4464E+00,2.4185E+00, | |
36965 | &0.0000E+00,0.0000E+00,1.2917E+00,1.2523E+00,1.2128E+00,1.1722E+00/ | |
36966 | DATA (XUDF_L(K),K= 685, 798) / | |
36967 | &1.1321E+00,1.0894E+00,1.0473E+00,1.0044E+00,9.6262E-01,9.1838E-01, | |
36968 | &8.7565E-01,8.3283E-01,7.9186E-01,7.6734E-01,7.4146E-01,7.1300E-01, | |
36969 | &6.8484E-01,6.5787E-01,6.3134E-01,6.0963E-01,5.8730E-01,5.6294E-01, | |
36970 | &5.3947E-01,5.1767E-01,4.9689E-01,4.8039E-01,4.6398E-01,4.4675E-01, | |
36971 | &4.3087E-01,4.1650E-01,4.0371E-01,3.9342E-01,3.8361E-01,3.7293E-01, | |
36972 | &3.6284E-01,3.5305E-01,3.4307E-01,3.3468E-01,3.2613E-01,3.1788E-01, | |
36973 | &3.1306E-01,3.1309E-01,3.1715E-01,3.2346E-01,3.3232E-01,3.4066E-01, | |
36974 | &3.4779E-01,3.5251E-01,3.5401E-01,3.5184E-01,3.4519E-01,3.3347E-01, | |
36975 | &3.1650E-01,2.9433E-01,2.6872E-01,3.6968E-01,3.7446E-01,3.8477E-01, | |
36976 | &4.0368E-01,4.3551E-01,4.8654E-01,5.6457E-01,6.8832E-01,8.9135E-01, | |
36977 | &1.2583E+00,2.0601E+00,0.0000E+00,0.0000E+00,1.6499E+00,1.5928E+00, | |
36978 | &1.5356E+00,1.4773E+00,1.4202E+00,1.3601E+00,1.3009E+00,1.2413E+00, | |
36979 | &1.1836E+00,1.1235E+00,1.0650E+00,1.0076E+00,9.5212E-01,9.1919E-01, | |
36980 | &8.8569E-01,8.4733E-01,8.1006E-01,7.7436E-01,7.3955E-01,7.1104E-01, | |
36981 | &6.8173E-01,6.4966E-01,6.1893E-01,5.9026E-01,5.6287E-01,5.4114E-01, | |
36982 | &5.1941E-01,4.9621E-01,4.7490E-01,4.5564E-01,4.3786E-01,4.2408E-01, | |
36983 | &4.1024E-01,3.9562E-01,3.8175E-01,3.6853E-01,3.5541E-01,3.4455E-01, | |
36984 | &3.3366E-01,3.2286E-01,3.1565E-01,3.1397E-01,3.1618E-01,3.2069E-01, | |
36985 | &3.2744E-01,3.3383E-01,3.3911E-01,3.4194E-01,3.4194E-01,3.3844E-01/ | |
36986 | DATA (XUDF_L(K),K= 799, 912) / | |
36987 | &3.3088E-01,3.1887E-01,3.0224E-01,2.8177E-01,2.5901E-01,3.4945E-01, | |
36988 | &3.5200E-01,3.5959E-01,3.7518E-01,4.0212E-01,4.4590E-01,5.1305E-01, | |
36989 | &6.1934E-01,7.9273E-01,1.1025E+00,1.7693E+00,0.0000E+00,0.0000E+00, | |
36990 | &2.0413E+00,1.9626E+00,1.8840E+00,1.8053E+00,1.7284E+00,1.6480E+00, | |
36991 | &1.5697E+00,1.4911E+00,1.4157E+00,1.3375E+00,1.2620E+00,1.1875E+00, | |
36992 | &1.1168E+00,1.0751E+00,1.0321E+00,9.8410E-01,9.3682E-01,8.9196E-01, | |
36993 | &8.4816E-01,8.1245E-01,7.7582E-01,7.3576E-01,6.9745E-01,6.6154E-01, | |
36994 | &6.2742E-01,6.0036E-01,5.7319E-01,5.4409E-01,5.1721E-01,4.9291E-01, | |
36995 | &4.7049E-01,4.5284E-01,4.3541E-01,4.1671E-01,3.9926E-01,3.8274E-01, | |
36996 | &3.6660E-01,3.5348E-01,3.4035E-01,3.2727E-01,3.1788E-01,3.1459E-01, | |
36997 | &3.1499E-01,3.1792E-01,3.2291E-01,3.2764E-01,3.3124E-01,3.3250E-01, | |
36998 | &3.3120E-01,3.2663E-01,3.1834E-01,3.0608E-01,2.8998E-01,2.7085E-01, | |
36999 | &2.5085E-01,3.3191E-01,3.3258E-01,3.3808E-01,3.5072E-01,3.7379E-01, | |
37000 | &4.1182E-01,4.7005E-01,5.6257E-01,7.1233E-01,9.7788E-01,1.5412E+00, | |
37001 | &0.0000E+00,0.0000E+00,2.6325E+00,2.5188E+00,2.4060E+00,2.2942E+00, | |
37002 | &2.1863E+00,2.0740E+00,1.9650E+00,1.8571E+00,1.7537E+00,1.6473E+00, | |
37003 | &1.5453E+00,1.4458E+00,1.3515E+00,1.2965E+00,1.2394E+00,1.1767E+00, | |
37004 | &1.1150E+00,1.0560E+00,9.9927E-01,9.5301E-01,9.0565E-01,8.5400E-01, | |
37005 | &8.0462E-01,7.5858E-01,7.1481E-01,6.7994E-01,6.4502E-01,6.0799E-01/ | |
37006 | DATA (XUDF_L(K),K= 913, 1026) / | |
37007 | &5.7349E-01,5.4206E-01,5.1299E-01,4.9028E-01,4.6789E-01,4.4387E-01, | |
37008 | &4.2168E-01,4.0096E-01,3.8070E-01,3.6457E-01,3.4857E-01,3.3249E-01, | |
37009 | &3.2026E-01,3.1503E-01,3.1326E-01,3.1423E-01,3.1703E-01,3.1974E-01, | |
37010 | &3.2120E-01,3.2086E-01,3.1799E-01,3.1221E-01,3.0315E-01,2.9072E-01, | |
37011 | &2.7522E-01,2.5796E-01,2.4114E-01,3.1079E-01,3.0956E-01,3.1267E-01, | |
37012 | &3.2223E-01,3.4089E-01,3.7246E-01,4.2134E-01,4.9853E-01,6.2305E-01, | |
37013 | &8.4191E-01,1.2983E+00,0.0000E+00,0.0000E+00,3.2997E+00,3.1427E+00, | |
37014 | &2.9900E+00,2.8374E+00,2.6927E+00,2.5421E+00,2.3973E+00,2.2549E+00, | |
37015 | &2.1191E+00,1.9809E+00,1.8488E+00,1.7209E+00,1.6001E+00,1.5300E+00, | |
37016 | &1.4576E+00,1.3771E+00,1.2999E+00,1.2268E+00,1.1551E+00,1.0975E+00, | |
37017 | &1.0385E+00,9.7437E-01,9.1327E-01,8.5649E-01,8.0236E-01,7.5952E-01, | |
37018 | &7.1667E-01,6.7091E-01,6.2847E-01,5.9005E-01,5.5422E-01,5.2636E-01, | |
37019 | &4.9890E-01,4.6976E-01,4.4269E-01,4.1752E-01,3.9377E-01,3.7477E-01, | |
37020 | &3.5594E-01,3.3710E-01,3.2226E-01,3.1511E-01,3.1131E-01,3.1067E-01, | |
37021 | &3.1132E-01,3.1227E-01,3.1198E-01,3.1021E-01,3.0606E-01,2.9926E-01, | |
37022 | &2.8958E-01,2.7716E-01,2.6233E-01,2.4655E-01,2.3275E-01,2.9229E-01, | |
37023 | &2.8941E-01,2.9061E-01,2.9753E-01,3.1273E-01,3.3909E-01,3.8034E-01, | |
37024 | &4.4548E-01,5.5028E-01,7.3256E-01,1.1074E+00,0.0000E+00,0.0000E+00, | |
37025 | &4.0557E+00,3.8486E+00,3.6460E+00,3.4480E+00,3.2579E+00,3.0626E+00/ | |
37026 | DATA (XUDF_L(K),K= 1027, 1140) / | |
37027 | &2.8756E+00,2.6929E+00,2.5196E+00,2.3441E+00,2.1778E+00,2.0170E+00, | |
37028 | &1.8670E+00,1.7797E+00,1.6902E+00,1.5909E+00,1.4960E+00,1.4058E+00, | |
37029 | &1.3191E+00,1.2484E+00,1.1764E+00,1.0991E+00,1.0253E+00,9.5689E-01, | |
37030 | &8.9197E-01,8.4046E-01,7.8904E-01,7.3442E-01,6.8367E-01,6.3780E-01, | |
37031 | &5.9520E-01,5.6218E-01,5.2934E-01,4.9500E-01,4.6300E-01,4.3370E-01, | |
37032 | &4.0611E-01,3.8431E-01,3.6284E-01,3.4121E-01,3.2389E-01,3.1494E-01, | |
37033 | &3.0926E-01,3.0697E-01,3.0594E-01,3.0501E-01,3.0330E-01,3.0019E-01, | |
37034 | &2.9492E-01,2.8734E-01,2.7718E-01,2.6476E-01,2.5057E-01,2.3646E-01, | |
37035 | &2.2503E-01,2.7558E-01,2.7132E-01,2.7089E-01,2.7569E-01,2.8794E-01, | |
37036 | &3.1000E-01,3.4491E-01,4.0016E-01,4.8886E-01,6.4191E-01,9.5232E-01, | |
37037 | &0.0000E+00,0.0000E+00,4.8799E+00,4.6116E+00,4.3560E+00,4.1035E+00, | |
37038 | &3.8608E+00,3.6163E+00,3.3822E+00,3.1557E+00,2.9412E+00,2.7247E+00, | |
37039 | &2.5209E+00,2.3248E+00,2.1421E+00,2.0368E+00,1.9287E+00,1.8094E+00, | |
37040 | &1.6955E+00,1.5877E+00,1.4841E+00,1.4003E+00,1.3154E+00,1.2237E+00, | |
37041 | &1.1368E+00,1.0563E+00,9.8015E-01,9.2005E-01,8.5978E-01,7.9615E-01, | |
37042 | &7.3715E-01,6.8369E-01,6.3441E-01,5.9609E-01,5.5830E-01,5.1865E-01, | |
37043 | &4.8192E-01,4.4872E-01,4.1747E-01,3.9300E-01,3.6895E-01,3.4483E-01, | |
37044 | &3.2508E-01,3.1459E-01,3.0709E-01,3.0328E-01,3.0056E-01,2.9840E-01, | |
37045 | &2.9543E-01,2.9107E-01,2.8485E-01,2.7655E-01,2.6610E-01,2.5368E-01/ | |
37046 | DATA (XUDF_L(K),K= 1141, 1254) / | |
37047 | &2.4019E-01,2.2736E-01,2.1837E-01,2.6080E-01,2.5542E-01,2.5362E-01, | |
37048 | &2.5693E-01,2.6661E-01,2.8505E-01,3.1490E-01,3.6226E-01,4.3798E-01, | |
37049 | &5.6769E-01,8.2836E-01,0.0000E+00,0.0000E+00,5.8340E+00,5.4940E+00, | |
37050 | &5.1700E+00,4.8532E+00,4.5515E+00,4.2463E+00,3.9559E+00,3.6752E+00, | |
37051 | &3.4138E+00,3.1496E+00,2.9022E+00,2.6648E+00,2.4450E+00,2.3189E+00, | |
37052 | &2.1896E+00,2.0476E+00,1.9120E+00,1.7843E+00,1.6621E+00,1.5639E+00, | |
37053 | &1.4648E+00,1.3569E+00,1.2556E+00,1.1618E+00,1.0734E+00,1.0037E+00, | |
37054 | &9.3416E-01,8.6065E-01,7.9257E-01,7.3145E-01,6.7463E-01,6.3082E-01, | |
37055 | &5.8786E-01,5.4262E-01,5.0118E-01,4.6374E-01,4.2883E-01,4.0146E-01, | |
37056 | &3.7490E-01,3.4814E-01,3.2612E-01,3.1397E-01,3.0482E-01,2.9958E-01, | |
37057 | &2.9536E-01,2.9178E-01,2.8756E-01,2.8208E-01,2.7504E-01,2.6611E-01, | |
37058 | &2.5539E-01,2.4319E-01,2.3031E-01,2.1877E-01,2.1195E-01,2.4673E-01, | |
37059 | &2.4036E-01,2.3746E-01,2.3912E-01,2.4677E-01,2.6223E-01,2.8748E-01, | |
37060 | &3.2792E-01,3.9255E-01,5.0271E-01,7.2095E-01,0.0000E+00,0.0000E+00, | |
37061 | &6.8578E+00,6.4388E+00,6.0380E+00,5.6501E+00,5.2825E+00,4.9103E+00, | |
37062 | &4.5613E+00,4.2230E+00,3.9070E+00,3.5911E+00,3.2966E+00,3.0156E+00, | |
37063 | &2.7567E+00,2.6078E+00,2.4563E+00,2.2905E+00,2.1319E+00,1.9837E+00, | |
37064 | &1.8421E+00,1.7287E+00,1.6141E+00,1.4902E+00,1.3730E+00,1.2663E+00, | |
37065 | &1.1652E+00,1.0858E+00,1.0067E+00,9.2337E-01,8.4648E-01,7.7710E-01/ | |
37066 | DATA (XUDF_L(K),K= 1255, 1368) / | |
37067 | &7.1333E-01,6.6392E-01,6.1566E-01,5.6531E-01,5.1904E-01,4.7761E-01, | |
37068 | &4.3908E-01,4.0927E-01,3.8022E-01,3.5109E-01,3.2686E-01,3.1318E-01, | |
37069 | &3.0244E-01,2.9602E-01,2.9031E-01,2.8538E-01,2.8024E-01,2.7382E-01, | |
37070 | &2.6607E-01,2.5668E-01,2.4571E-01,2.3364E-01,2.2155E-01,2.1116E-01, | |
37071 | &2.0617E-01,2.3421E-01,2.2704E-01,2.2320E-01,2.2366E-01,2.2952E-01, | |
37072 | &2.4241E-01,2.6402E-01,2.9884E-01,3.5437E-01,4.4860E-01,6.3331E-01, | |
37073 | &0.0000E+00,0.0000E+00,7.9784E+00,7.4673E+00,6.9820E+00,6.5121E+00, | |
37074 | &6.0712E+00,5.6250E+00,5.2080E+00,4.8065E+00,4.4309E+00,4.0590E+00, | |
37075 | &3.7131E+00,3.3843E+00,3.0816E+00,2.9094E+00,2.7332E+00,2.5420E+00, | |
37076 | &2.3595E+00,2.1895E+00,2.0271E+00,1.8966E+00,1.7658E+00,1.6248E+00, | |
37077 | &1.4933E+00,1.3718E+00,1.2579E+00,1.1683E+00,1.0795E+00,9.8589E-01, | |
37078 | &8.9996E-01,8.2253E-01,7.5153E-01,6.9648E-01,6.4287E-01,5.8736E-01, | |
37079 | &5.3655E-01,4.9109E-01,4.4891E-01,4.1655E-01,3.8518E-01,3.5367E-01, | |
37080 | &3.2738E-01,3.1221E-01,3.0006E-01,2.9246E-01,2.8544E-01,2.7940E-01, | |
37081 | &2.7319E-01,2.6601E-01,2.5763E-01,2.4782E-01,2.3676E-01,2.2486E-01, | |
37082 | &2.1329E-01,2.0405E-01,2.0083E-01,2.2267E-01,2.1489E-01,2.1027E-01, | |
37083 | &2.0967E-01,2.1409E-01,2.2473E-01,2.4320E-01,2.7316E-01,3.2113E-01, | |
37084 | &4.0209E-01,5.5899E-01,0.0000E+00,0.0000E+00,9.1575E+00,8.5458E+00, | |
37085 | &7.9700E+00,7.4123E+00,6.8876E+00,6.3653E+00,5.8736E+00,5.4042E+00/ | |
37086 | DATA (XUDF_L(K),K= 1369, 1482) / | |
37087 | &4.9684E+00,4.5359E+00,4.1366E+00,3.7576E+00,3.4110E+00,3.2138E+00, | |
37088 | &3.0122E+00,2.7943E+00,2.5871E+00,2.3944E+00,2.2102E+00,2.0646E+00, | |
37089 | &1.9163E+00,1.7581E+00,1.6109E+00,1.4753E+00,1.3483E+00,1.2486E+00, | |
37090 | &1.1500E+00,1.0462E+00,9.5130E-01,8.6585E-01,7.8770E-01,7.2741E-01, | |
37091 | &6.6891E-01,6.0781E-01,5.5266E-01,5.0342E-01,4.5788E-01,4.2322E-01, | |
37092 | &3.8960E-01,3.5594E-01,3.2768E-01,3.1125E-01,2.9779E-01,2.8890E-01, | |
37093 | &2.8091E-01,2.7385E-01,2.6670E-01,2.5886E-01,2.4989E-01,2.3976E-01, | |
37094 | &2.2861E-01,2.1703E-01,2.0604E-01,1.9777E-01,1.9598E-01,2.1238E-01, | |
37095 | &2.0408E-01,1.9879E-01,1.9735E-01,2.0048E-01,2.0933E-01,2.2523E-01, | |
37096 | &2.5120E-01,2.9296E-01,3.6305E-01,4.9711E-01,0.0000E+00,0.0000E+00, | |
37097 | &1.0956E+01,1.0188E+01,9.4660E+00,8.7704E+00,8.1209E+00,7.4727E+00, | |
37098 | &6.8721E+00,6.2972E+00,5.7646E+00,5.2434E+00,4.7595E+00,4.3051E+00, | |
37099 | &3.8911E+00,3.6559E+00,3.4174E+00,3.1598E+00,2.9153E+00,2.6889E+00, | |
37100 | &2.4732E+00,2.3031E+00,2.1311E+00,1.9475E+00,1.7771E+00,1.6202E+00, | |
37101 | &1.4748E+00,1.3609E+00,1.2481E+00,1.1301E+00,1.0222E+00,9.2549E-01, | |
37102 | &8.3728E-01,7.6947E-01,7.0373E-01,6.3561E-01,5.7438E-01,5.1959E-01, | |
37103 | &4.6984E-01,4.3187E-01,3.9529E-01,3.5864E-01,3.2783E-01,3.0967E-01, | |
37104 | &2.9444E-01,2.8428E-01,2.7469E-01,2.6638E-01,2.5813E-01,2.4942E-01, | |
37105 | &2.3986E-01,2.2937E-01,2.1819E-01,2.0682E-01,1.9665E-01,1.8966E-01/ | |
37106 | DATA (XUDF_L(K),K= 1483, 1596) / | |
37107 | &1.8971E-01,1.9926E-01,1.9036E-01,1.8442E-01,1.8192E-01,1.8362E-01, | |
37108 | &1.9037E-01,2.0318E-01,2.2459E-01,2.5904E-01,3.1665E-01,4.2407E-01, | |
37109 | &0.0000E+00,0.0000E+00,1.2798E+01,1.1861E+01,1.0986E+01,1.0144E+01, | |
37110 | &9.3643E+00,8.5887E+00,7.8706E+00,7.1866E+00,6.5568E+00,5.9419E+00, | |
37111 | &5.3754E+00,4.8419E+00,4.3593E+00,4.0864E+00,3.8109E+00,3.5127E+00, | |
37112 | &3.2315E+00,2.9714E+00,2.7252E+00,2.5309E+00,2.3356E+00,2.1269E+00, | |
37113 | &1.9338E+00,1.7578E+00,1.5939E+00,1.4656E+00,1.3394E+00,1.2075E+00, | |
37114 | &1.0875E+00,9.8023E-01,8.8256E-01,8.0772E-01,7.3533E-01,6.6054E-01, | |
37115 | &5.9364E-01,5.3423E-01,4.8009E-01,4.3930E-01,4.0003E-01,3.6079E-01, | |
37116 | &3.2768E-01,3.0809E-01,2.9130E-01,2.7993E-01,2.6898E-01,2.5976E-01, | |
37117 | &2.5062E-01,2.4123E-01,2.3116E-01,2.2040E-01,2.0917E-01,1.9814E-01, | |
37118 | &1.8865E-01,1.8272E-01,1.8428E-01,1.8820E-01,1.7883E-01,1.7238E-01, | |
37119 | &1.6914E-01,1.6979E-01,1.7482E-01,1.8534E-01,2.0325E-01,2.3214E-01, | |
37120 | &2.8022E-01,3.6659E-01,0.0000E+00,0.0000E+00,1.4900E+01,1.3767E+01, | |
37121 | &1.2708E+01,1.1700E+01,1.0766E+01,9.8403E+00,8.9832E+00,8.1757E+00, | |
37122 | &7.4366E+00,6.7121E+00,6.0486E+00,5.4300E+00,4.8704E+00,4.5555E+00, | |
37123 | &4.2371E+00,3.8955E+00,3.5734E+00,3.2760E+00,2.9952E+00,2.7738E+00, | |
37124 | &2.5528E+00,2.3175E+00,2.1001E+00,1.9012E+00,1.7176E+00,1.5750E+00, | |
37125 | &1.4344E+00,1.2880E+00,1.1547E+00,1.0364E+00,9.2859E-01,8.4652E-01/ | |
37126 | DATA (XUDF_L(K),K= 1597, 1710) / | |
37127 | &7.6723E-01,6.8578E-01,6.1255E-01,5.4848E-01,4.9034E-01,4.4649E-01, | |
37128 | &4.0456E-01,3.6275E-01,3.2738E-01,3.0624E-01,2.8805E-01,2.7544E-01, | |
37129 | &2.6343E-01,2.5315E-01,2.4318E-01,2.3314E-01,2.2263E-01,2.1166E-01, | |
37130 | &2.0051E-01,1.8983E-01,1.8102E-01,1.7610E-01,1.7901E-01,1.7764E-01, | |
37131 | &1.6791E-01,1.6102E-01,1.5715E-01,1.5684E-01,1.6056E-01,1.6899E-01, | |
37132 | &1.8376E-01,2.0786E-01,2.4776E-01,3.1470E-01,0.0000E+00,0.0000E+00, | |
37133 | &1.7212E+01,1.5853E+01,1.4590E+01,1.3390E+01,1.2283E+01,1.1191E+01, | |
37134 | &1.0185E+01,9.2395E+00,8.3762E+00,7.5315E+00,6.7670E+00,6.0503E+00, | |
37135 | &5.4086E+00,5.0481E+00,4.6843E+00,4.2940E+00,3.9280E+00,3.5917E+00, | |
37136 | &3.2752E+00,3.0252E+00,2.7768E+00,2.5132E+00,2.2690E+00,2.0490E+00, | |
37137 | &1.8445E+00,1.6857E+00,1.5301E+00,1.3685E+00,1.2219E+00,1.0920E+00, | |
37138 | &9.7438E-01,8.8478E-01,7.9825E-01,7.1007E-01,6.3111E-01,5.6196E-01, | |
37139 | &5.0016E-01,4.5321E-01,4.0867E-01,3.6435E-01,3.2686E-01,3.0431E-01, | |
37140 | &2.8470E-01,2.7109E-01,2.5789E-01,2.4674E-01,2.3605E-01,2.2547E-01, | |
37141 | &2.1459E-01,2.0348E-01,1.9237E-01,1.8201E-01,1.7376E-01,1.6982E-01, | |
37142 | &1.7398E-01,1.6789E-01,1.5795E-01,1.5065E-01,1.4630E-01,1.4521E-01, | |
37143 | &1.4773E-01,1.5443E-01,1.6659E-01,1.8664E-01,2.1966E-01,2.6878E-01, | |
37144 | &0.0000E+00,0.0000E+00,1.9526E+01,1.7951E+01,1.6470E+01,1.5074E+01, | |
37145 | &1.3790E+01,1.2527E+01,1.1370E+01,1.0282E+01,9.2958E+00,8.3330E+00/ | |
37146 | DATA (XUDF_L(K),K= 1711, 1824) / | |
37147 | &7.4603E+00,6.6536E+00,5.9285E+00,5.5219E+00,5.1141E+00,4.6768E+00, | |
37148 | &4.2681E+00,3.8926E+00,3.5402E+00,3.2626E+00,2.9882E+00,2.6963E+00, | |
37149 | &2.4284E+00,2.1851E+00,1.9619E+00,1.7885E+00,1.6187E+00,1.4429E+00, | |
37150 | &1.2838E+00,1.1431E+00,1.0159E+00,9.1924E-01,8.2663E-01,7.3180E-01, | |
37151 | &6.4793E-01,5.7429E-01,5.0828E-01,4.5904E-01,4.1215E-01,3.6558E-01, | |
37152 | &3.2620E-01,3.0238E-01,2.8167E-01,2.6700E-01,2.5302E-01,2.4098E-01, | |
37153 | &2.2975E-01,2.1873E-01,2.0756E-01,1.9633E-01,1.8532E-01,1.7533E-01, | |
37154 | &1.6763E-01,1.6450E-01,1.6959E-01,1.5953E-01,1.4943E-01,1.4185E-01, | |
37155 | &1.3716E-01,1.3545E-01,1.3705E-01,1.4238E-01,1.5258E-01,1.6945E-01, | |
37156 | &1.9705E-01,2.3049E-01,0.0000E+00,0.0000E+00,2.2141E+01,2.0286E+01, | |
37157 | &1.8570E+01,1.6948E+01,1.5466E+01,1.4010E+01,1.2679E+01,1.1431E+01, | |
37158 | &1.0303E+01,9.2106E+00,8.2239E+00,7.3077E+00,6.4926E+00,6.0348E+00, | |
37159 | &5.5765E+00,5.0879E+00,4.6321E+00,4.2138E+00,3.8233E+00,3.5162E+00, | |
37160 | &3.2122E+00,2.8907E+00,2.5960E+00,2.3300E+00,2.0856E+00,1.8954E+00, | |
37161 | &1.7110E+00,1.5199E+00,1.3476E+00,1.1955E+00,1.0584E+00,9.5478E-01, | |
37162 | &8.5531E-01,7.5417E-01,6.6439E-01,5.8623E-01,5.1682E-01,4.6468E-01, | |
37163 | &4.1541E-01,3.6662E-01,3.2538E-01,3.0035E-01,2.7843E-01,2.6291E-01, | |
37164 | &2.4798E-01,2.3522E-01,2.2346E-01,2.1203E-01,2.0062E-01,1.8935E-01, | |
37165 | &1.7843E-01,1.6874E-01,1.6163E-01,1.5920E-01,1.6520E-01,1.5147E-01/ | |
37166 | DATA (XUDF_L(K),K= 1825, 1836) / | |
37167 | &1.4120E-01,1.3349E-01,1.2844E-01,1.2620E-01,1.2701E-01,1.3118E-01, | |
37168 | &1.3954E-01,1.5369E-01,1.7631E-01,1.9416E-01,0.0000E+00,0.0000E+00/ | |
37169 | DATA (XSF_L(K),K= 1, 114) / | |
37170 | &8.9277E-03,9.2838E-03,9.6380E-03,9.9960E-03,1.0349E-02,1.0719E-02, | |
37171 | &1.1082E-02,1.1442E-02,1.1792E-02,1.2148E-02,1.2489E-02,1.2817E-02, | |
37172 | &1.3124E-02,1.3295E-02,1.3474E-02,1.3661E-02,1.3835E-02,1.3985E-02, | |
37173 | &1.4121E-02,1.4217E-02,1.4303E-02,1.4379E-02,1.4419E-02,1.4434E-02, | |
37174 | &1.4412E-02,1.4366E-02,1.4286E-02,1.4158E-02,1.3991E-02,1.3790E-02, | |
37175 | &1.3553E-02,1.3335E-02,1.3094E-02,1.2821E-02,1.2580E-02,1.2410E-02, | |
37176 | &1.2357E-02,1.2459E-02,1.2790E-02,1.3571E-02,1.5018E-02,1.6665E-02, | |
37177 | &1.9113E-02,2.1832E-02,2.5587E-02,2.9818E-02,3.4535E-02,3.9813E-02, | |
37178 | &4.5737E-02,5.2358E-02,5.9765E-02,6.8021E-02,7.7185E-02,8.7258E-02, | |
37179 | &9.8198E-02,1.1073E-01,1.4216E-01,1.8364E-01,2.3959E-01,3.1758E-01, | |
37180 | &4.3050E-01,6.0203E-01,8.8214E-01,1.3845E+00,2.4294E+00,5.2463E+00, | |
37181 | &1.8903E+01,0.0000E+00,1.4987E-02,1.5468E-02,1.5936E-02,1.6403E-02, | |
37182 | &1.6855E-02,1.7319E-02,1.7760E-02,1.8194E-02,1.8600E-02,1.9008E-02, | |
37183 | &1.9382E-02,1.9730E-02,2.0033E-02,2.0199E-02,2.0359E-02,2.0523E-02, | |
37184 | &2.0654E-02,2.0760E-02,2.0831E-02,2.0870E-02,2.0886E-02,2.0858E-02, | |
37185 | &2.0798E-02,2.0680E-02,2.0523E-02,2.0363E-02,2.0127E-02,1.9825E-02, | |
37186 | &1.9464E-02,1.9060E-02,1.8607E-02,1.8200E-02,1.7750E-02,1.7240E-02, | |
37187 | &1.6759E-02,1.6362E-02,1.6103E-02,1.6050E-02,1.6240E-02,1.6916E-02, | |
37188 | &1.8336E-02,2.0030E-02,2.2586E-02,2.5447E-02,2.9418E-02,3.3874E-02/ | |
37189 | DATA (XSF_L(K),K= 115, 228) / | |
37190 | &3.8821E-02,4.4375E-02,5.0509E-02,5.7343E-02,6.4974E-02,7.3385E-02, | |
37191 | &8.2640E-02,9.2732E-02,1.0354E-01,1.1667E-01,1.4809E-01,1.8910E-01, | |
37192 | &2.4387E-01,3.1940E-01,4.2764E-01,5.9054E-01,8.5228E-01,1.3150E+00, | |
37193 | &2.2623E+00,4.7596E+00,1.6445E+01,0.0000E+00,2.5010E-02,2.5616E-02, | |
37194 | &2.6180E-02,2.6758E-02,2.7279E-02,2.7792E-02,2.8274E-02,2.8729E-02, | |
37195 | &2.9134E-02,2.9513E-02,2.9836E-02,3.0110E-02,3.0324E-02,3.0417E-02, | |
37196 | &3.0492E-02,3.0537E-02,3.0551E-02,3.0517E-02,3.0432E-02,3.0326E-02, | |
37197 | &3.0181E-02,2.9954E-02,2.9663E-02,2.9316E-02,2.8913E-02,2.8508E-02, | |
37198 | &2.8021E-02,2.7422E-02,2.6741E-02,2.5997E-02,2.5204E-02,2.4500E-02, | |
37199 | &2.3734E-02,2.2858E-02,2.2019E-02,2.1281E-02,2.0698E-02,2.0402E-02, | |
37200 | &2.0365E-02,2.0844E-02,2.2137E-02,2.3807E-02,2.6404E-02,2.9338E-02, | |
37201 | &3.3433E-02,3.8036E-02,4.3135E-02,4.8799E-02,5.5061E-02,6.1999E-02, | |
37202 | &6.9633E-02,7.8024E-02,8.7156E-02,9.6998E-02,1.0742E-01,1.2099E-01, | |
37203 | &1.5162E-01,1.9121E-01,2.4363E-01,3.1510E-01,4.1638E-01,5.6669E-01, | |
37204 | &8.0557E-01,1.2216E+00,2.0572E+00,4.2084E+00,1.3911E+01,0.0000E+00, | |
37205 | &4.2554E-02,4.3210E-02,4.3820E-02,4.4379E-02,4.4862E-02,4.5317E-02, | |
37206 | &4.5708E-02,4.6037E-02,4.6300E-02,4.6434E-02,4.6540E-02,4.6530E-02, | |
37207 | &4.6426E-02,4.6317E-02,4.6155E-02,4.5919E-02,4.5622E-02,4.5267E-02, | |
37208 | &4.4833E-02,4.4425E-02,4.3932E-02,4.3298E-02,4.2582E-02,4.1785E-02/ | |
37209 | DATA (XSF_L(K),K= 229, 342) / | |
37210 | &4.0903E-02,4.0097E-02,3.9179E-02,3.8047E-02,3.6815E-02,3.5547E-02, | |
37211 | &3.4199E-02,3.3020E-02,3.1748E-02,3.0298E-02,2.8905E-02,2.7644E-02, | |
37212 | &2.6563E-02,2.5882E-02,2.5485E-02,2.5614E-02,2.6651E-02,2.8199E-02, | |
37213 | &3.0731E-02,3.3652E-02,3.7768E-02,4.2390E-02,4.7530E-02,5.3188E-02, | |
37214 | &5.9436E-02,6.6257E-02,7.3734E-02,8.1918E-02,9.0696E-02,1.0004E-01, | |
37215 | &1.0978E-01,1.2357E-01,1.5274E-01,1.8999E-01,2.3888E-01,3.0452E-01, | |
37216 | &3.9656E-01,5.3136E-01,7.4246E-01,1.1043E+00,1.8158E+00,3.6023E+00, | |
37217 | &0.0000E+00,0.0000E+00,7.3602E-02,7.4085E-02,7.4460E-02,7.4729E-02, | |
37218 | &7.4904E-02,7.4982E-02,7.4902E-02,7.4713E-02,7.4446E-02,7.3972E-02, | |
37219 | &7.3397E-02,7.2626E-02,7.1803E-02,7.1200E-02,7.0479E-02,6.9610E-02, | |
37220 | &6.8654E-02,6.7624E-02,6.6495E-02,6.5467E-02,6.4313E-02,6.2898E-02, | |
37221 | &6.1380E-02,5.9788E-02,5.8079E-02,5.6557E-02,5.4876E-02,5.2866E-02, | |
37222 | &5.0733E-02,4.8592E-02,4.6341E-02,4.4415E-02,4.2370E-02,4.0073E-02, | |
37223 | &3.7825E-02,3.5778E-02,3.3956E-02,3.2702E-02,3.1749E-02,3.1334E-02, | |
37224 | &3.1922E-02,3.3216E-02,3.5534E-02,3.8322E-02,4.2321E-02,4.6830E-02, | |
37225 | &5.1816E-02,5.7335E-02,6.3369E-02,6.9947E-02,7.7109E-02,8.4752E-02, | |
37226 | &9.2948E-02,1.0153E-01,1.1031E-01,1.2405E-01,1.5100E-01,1.8509E-01, | |
37227 | &2.2905E-01,2.8761E-01,3.6847E-01,4.8537E-01,6.6543E-01,9.6831E-01, | |
37228 | &1.5524E+00,2.9766E+00,0.0000E+00,0.0000E+00,1.1509E-01,1.1500E-01/ | |
37229 | DATA (XSF_L(K),K= 343, 456) / | |
37230 | &1.1474E-01,1.1430E-01,1.1371E-01,1.1292E-01,1.1196E-01,1.1079E-01, | |
37231 | &1.0948E-01,1.0791E-01,1.0620E-01,1.0426E-01,1.0215E-01,1.0076E-01, | |
37232 | &9.9224E-02,9.7466E-02,9.5472E-02,9.3507E-02,9.1346E-02,8.9460E-02, | |
37233 | &8.7382E-02,8.4914E-02,8.2326E-02,7.9663E-02,7.6874E-02,7.4459E-02, | |
37234 | &7.1794E-02,6.8694E-02,6.5489E-02,6.2266E-02,5.8964E-02,5.6164E-02, | |
37235 | &5.3226E-02,4.9916E-02,4.6721E-02,4.3794E-02,4.1128E-02,3.9225E-02, | |
37236 | &3.7654E-02,3.6613E-02,3.6666E-02,3.7626E-02,3.9655E-02,4.2227E-02, | |
37237 | &4.6000E-02,5.0288E-02,5.5044E-02,6.0308E-02,6.6020E-02,7.2218E-02, | |
37238 | &7.8943E-02,8.6079E-02,9.3611E-02,1.0141E-01,1.0925E-01,1.2274E-01, | |
37239 | &1.4748E-01,1.7840E-01,2.1791E-01,2.6997E-01,3.4109E-01,4.4280E-01, | |
37240 | &5.9706E-01,8.5325E-01,1.3371E+00,2.4909E+00,0.0000E+00,0.0000E+00, | |
37241 | &1.8131E-01,1.7986E-01,1.7802E-01,1.7597E-01,1.7372E-01,1.7110E-01, | |
37242 | &1.6825E-01,1.6515E-01,1.6187E-01,1.5820E-01,1.5428E-01,1.5016E-01, | |
37243 | &1.4582E-01,1.4314E-01,1.4017E-01,1.3677E-01,1.3315E-01,1.2951E-01, | |
37244 | &1.2571E-01,1.2248E-01,1.1891E-01,1.1472E-01,1.1045E-01,1.0615E-01, | |
37245 | &1.0173E-01,9.7944E-02,9.3854E-02,8.9131E-02,8.4347E-02,7.9597E-02, | |
37246 | &7.4799E-02,7.0788E-02,6.6599E-02,6.1932E-02,5.7438E-02,5.3307E-02, | |
37247 | &4.9546E-02,4.6816E-02,4.4417E-02,4.2536E-02,4.1862E-02,4.2361E-02, | |
37248 | &4.3960E-02,4.6198E-02,4.9612E-02,5.3553E-02,5.7974E-02,6.2830E-02/ | |
37249 | DATA (XSF_L(K),K= 457, 570) / | |
37250 | &6.8141E-02,7.3865E-02,7.9970E-02,8.6422E-02,9.3160E-02,1.0006E-01, | |
37251 | &1.0685E-01,1.1989E-01,1.4199E-01,1.6937E-01,2.0407E-01,2.4925E-01, | |
37252 | &3.1029E-01,3.9635E-01,5.2529E-01,7.3579E-01,1.1263E+00,2.0347E+00, | |
37253 | &0.0000E+00,0.0000E+00,2.6278E-01,2.5883E-01,2.5460E-01,2.5007E-01, | |
37254 | &2.4526E-01,2.3995E-01,2.3437E-01,2.2848E-01,2.2242E-01,2.1578E-01, | |
37255 | &2.0894E-01,2.0181E-01,1.9465E-01,1.9018E-01,1.8540E-01,1.7984E-01, | |
37256 | &1.7415E-01,1.6846E-01,1.6261E-01,1.5768E-01,1.5234E-01,1.4615E-01, | |
37257 | &1.3987E-01,1.3368E-01,1.2736E-01,1.2199E-01,1.1628E-01,1.0975E-01, | |
37258 | &1.0321E-01,9.6788E-02,9.0380E-02,8.5059E-02,7.9532E-02,7.3436E-02, | |
37259 | &6.7594E-02,6.2243E-02,5.7363E-02,5.3720E-02,5.0502E-02,4.7772E-02, | |
37260 | &4.6346E-02,4.6358E-02,4.7497E-02,4.9377E-02,5.2401E-02,5.5965E-02, | |
37261 | &6.0009E-02,6.4489E-02,6.9334E-02,7.4546E-02,8.0117E-02,8.5936E-02, | |
37262 | &9.1972E-02,9.8056E-02,1.0398E-01,1.1644E-01,1.3628E-01,1.6068E-01, | |
37263 | &1.9127E-01,2.3085E-01,2.8377E-01,3.5756E-01,4.6698E-01,6.4315E-01, | |
37264 | &9.6485E-01,1.6969E+00,0.0000E+00,0.0000E+00,3.6944E-01,3.6187E-01, | |
37265 | &3.5380E-01,3.4525E-01,3.3659E-01,3.2716E-01,3.1761E-01,3.0767E-01, | |
37266 | &2.9759E-01,2.8675E-01,2.7586E-01,2.6462E-01,2.5339E-01,2.4660E-01, | |
37267 | &2.3933E-01,2.3101E-01,2.2257E-01,2.1415E-01,2.0571E-01,1.9854E-01, | |
37268 | &1.9083E-01,1.8216E-01,1.7338E-01,1.6480E-01,1.5613E-01,1.4885E-01/ | |
37269 | DATA (XSF_L(K),K= 571, 684) / | |
37270 | &1.4115E-01,1.3244E-01,1.2380E-01,1.1542E-01,1.0713E-01,1.0031E-01, | |
37271 | &9.3226E-02,8.5515E-02,7.8171E-02,7.1449E-02,6.5307E-02,6.0723E-02, | |
37272 | &5.6523E-02,5.2878E-02,5.0622E-02,5.0109E-02,5.0720E-02,5.2187E-02, | |
37273 | &5.4770E-02,5.7950E-02,6.1582E-02,6.5595E-02,6.9997E-02,7.4716E-02, | |
37274 | &7.9677E-02,8.4886E-02,9.0221E-02,9.5543E-02,1.0065E-01,1.1245E-01, | |
37275 | &1.3012E-01,1.5166E-01,1.7859E-01,2.1305E-01,2.5881E-01,3.2188E-01, | |
37276 | &4.1454E-01,5.6186E-01,8.2718E-01,1.4188E+00,0.0000E+00,0.0000E+00, | |
37277 | &4.9195E-01,4.7916E-01,4.6620E-01,4.5277E-01,4.3908E-01,4.2463E-01, | |
37278 | &4.0985E-01,3.9491E-01,3.7975E-01,3.6377E-01,3.4790E-01,3.3178E-01, | |
37279 | &3.1592E-01,3.0640E-01,2.9622E-01,2.8462E-01,2.7303E-01,2.6160E-01, | |
37280 | &2.5012E-01,2.4047E-01,2.3023E-01,2.1867E-01,2.0717E-01,1.9597E-01, | |
37281 | &1.8477E-01,1.7546E-01,1.6568E-01,1.5468E-01,1.4387E-01,1.3343E-01, | |
37282 | &1.2319E-01,1.1482E-01,1.0622E-01,9.6828E-02,8.7978E-02,7.9884E-02, | |
37283 | &7.2526E-02,6.6973E-02,6.1948E-02,5.7359E-02,5.4304E-02,5.3263E-02, | |
37284 | &5.3381E-02,5.4456E-02,5.6601E-02,5.9380E-02,6.2613E-02,6.6252E-02, | |
37285 | &7.0174E-02,7.4432E-02,7.8943E-02,8.3559E-02,8.8282E-02,9.2963E-02, | |
37286 | &9.7382E-02,1.0858E-01,1.2441E-01,1.4363E-01,1.6745E-01,1.9778E-01, | |
37287 | &2.3771E-01,2.9246E-01,3.7200E-01,4.9738E-01,7.2010E-01,1.2083E+00, | |
37288 | &0.0000E+00,0.0000E+00,6.4521E-01,6.2534E-01,6.0540E-01,5.8499E-01/ | |
37289 | DATA (XSF_L(K),K= 685, 798) / | |
37290 | &5.6467E-01,5.4301E-01,5.2143E-01,4.9951E-01,4.7813E-01,4.5538E-01, | |
37291 | &4.3325E-01,4.1083E-01,3.8899E-01,3.7591E-01,3.6210E-01,3.4648E-01, | |
37292 | &3.3091E-01,3.1578E-01,3.0062E-01,2.8797E-01,2.7469E-01,2.5979E-01, | |
37293 | &2.4501E-01,2.3066E-01,2.1649E-01,2.0481E-01,1.9252E-01,1.7884E-01, | |
37294 | &1.6549E-01,1.5274E-01,1.4029E-01,1.3018E-01,1.1985E-01,1.0865E-01, | |
37295 | &9.8135E-02,8.8550E-02,7.9829E-02,7.3318E-02,6.7269E-02,6.1748E-02, | |
37296 | &5.7838E-02,5.6250E-02,5.5826E-02,5.6474E-02,5.8181E-02,6.0533E-02, | |
37297 | &6.3373E-02,6.6563E-02,7.0085E-02,7.3865E-02,7.7842E-02,8.1937E-02, | |
37298 | &8.6092E-02,9.0169E-02,9.3962E-02,1.0448E-01,1.1858E-01,1.3561E-01, | |
37299 | &1.5663E-01,1.8318E-01,2.1803E-01,2.6529E-01,3.3349E-01,4.3985E-01, | |
37300 | &6.2661E-01,1.0291E+00,0.0000E+00,0.0000E+00,8.2462E-01,7.9558E-01, | |
37301 | &7.6680E-01,7.3764E-01,7.0860E-01,6.7834E-01,6.4822E-01,6.1798E-01, | |
37302 | &5.8880E-01,5.5792E-01,5.2800E-01,4.9801E-01,4.6912E-01,4.5197E-01, | |
37303 | &4.3393E-01,4.1360E-01,3.9348E-01,3.7394E-01,3.5462E-01,3.3856E-01, | |
37304 | &3.2180E-01,3.0303E-01,2.8460E-01,2.6681E-01,2.4932E-01,2.3502E-01, | |
37305 | &2.2005E-01,2.0359E-01,1.8747E-01,1.7224E-01,1.5746E-01,1.4551E-01, | |
37306 | &1.3337E-01,1.2028E-01,1.0805E-01,9.6986E-02,8.6877E-02,7.9334E-02, | |
37307 | &7.2326E-02,6.5799E-02,6.1060E-02,5.8911E-02,5.7957E-02,5.8189E-02, | |
37308 | &5.9441E-02,6.1387E-02,6.3834E-02,6.6632E-02,6.9732E-02,7.3070E-02/ | |
37309 | DATA (XSF_L(K),K= 799, 912) / | |
37310 | &7.6595E-02,8.0190E-02,8.3816E-02,8.7358E-02,9.0631E-02,1.0046E-01, | |
37311 | &1.1304E-01,1.2815E-01,1.4670E-01,1.7006E-01,2.0049E-01,2.4154E-01, | |
37312 | &3.0039E-01,3.9121E-01,5.4894E-01,8.8378E-01,0.0000E+00,0.0000E+00, | |
37313 | &1.0199E+00,9.8025E-01,9.4100E-01,9.0151E-01,8.6283E-01,8.2243E-01, | |
37314 | &7.8262E-01,7.4321E-01,7.0465E-01,6.6494E-01,6.2647E-01,5.8811E-01, | |
37315 | &5.5152E-01,5.2985E-01,5.0721E-01,4.8183E-01,4.5681E-01,4.3274E-01, | |
37316 | &4.0883E-01,3.8916E-01,3.6878E-01,3.4589E-01,3.2366E-01,3.0238E-01, | |
37317 | &2.8152E-01,2.6437E-01,2.4685E-01,2.2733E-01,2.0858E-01,1.9085E-01, | |
37318 | &1.7375E-01,1.6000E-01,1.4607E-01,1.3115E-01,1.1722E-01,1.0469E-01, | |
37319 | &9.3284E-02,8.4739E-02,7.6803E-02,6.9420E-02,6.3844E-02,6.1178E-02, | |
37320 | &5.9720E-02,5.9561E-02,6.0398E-02,6.1984E-02,6.4051E-02,6.6494E-02, | |
37321 | &6.9202E-02,7.2161E-02,7.5274E-02,7.8453E-02,8.1651E-02,8.4728E-02, | |
37322 | &8.7564E-02,9.6777E-02,1.0806E-01,1.2157E-01,1.3806E-01,1.5882E-01, | |
37323 | &1.8566E-01,2.2170E-01,2.7301E-01,3.5168E-01,4.8696E-01,7.7010E-01, | |
37324 | &0.0000E+00,0.0000E+00,1.3158E+00,1.2585E+00,1.2024E+00,1.1462E+00, | |
37325 | &1.0919E+00,1.0352E+00,9.8042E-01,9.2608E-01,8.7345E-01,8.1987E-01, | |
37326 | &7.6814E-01,7.1724E-01,6.6882E-01,6.4053E-01,6.1093E-01,5.7796E-01, | |
37327 | &5.4572E-01,5.1470E-01,4.8433E-01,4.5934E-01,4.3358E-01,4.0495E-01, | |
37328 | &3.7717E-01,3.5082E-01,3.2513E-01,3.0408E-01,2.8258E-01,2.5918E-01/ | |
37329 | DATA (XSF_L(K),K= 913, 1026) / | |
37330 | &2.3648E-01,2.1538E-01,1.9510E-01,1.7888E-01,1.6255E-01,1.4508E-01, | |
37331 | &1.2895E-01,1.1443E-01,1.0131E-01,9.1507E-02,8.2387E-02,7.3778E-02, | |
37332 | &6.7147E-02,6.3813E-02,6.1721E-02,6.1065E-02,6.1373E-02,6.2475E-02, | |
37333 | &6.4105E-02,6.6079E-02,6.8362E-02,7.0856E-02,7.3440E-02,7.6143E-02, | |
37334 | &7.8812E-02,8.1388E-02,8.3726E-02,9.2167E-02,1.0190E-01,1.1355E-01, | |
37335 | &1.2780E-01,1.4554E-01,1.6841E-01,1.9900E-01,2.4223E-01,3.0775E-01, | |
37336 | &4.1920E-01,6.4849E-01,0.0000E+00,0.0000E+00,1.6483E+00,1.5703E+00, | |
37337 | &1.4940E+00,1.4180E+00,1.3449E+00,1.2694E+00,1.1966E+00,1.1250E+00, | |
37338 | &1.0566E+00,9.8644E-01,9.1985E-01,8.5482E-01,7.9312E-01,7.5722E-01, | |
37339 | &7.1986E-01,6.7849E-01,6.3821E-01,5.9972E-01,5.6214E-01,5.3143E-01, | |
37340 | &4.9987E-01,4.6500E-01,4.3136E-01,3.9956E-01,3.6875E-01,3.4379E-01, | |
37341 | &3.1832E-01,2.9044E-01,2.6397E-01,2.3923E-01,2.1580E-01,1.9706E-01, | |
37342 | &1.7829E-01,1.5838E-01,1.3999E-01,1.2356E-01,1.0875E-01,9.7664E-02, | |
37343 | &8.7392E-02,7.7645E-02,7.0035E-02,6.6062E-02,6.3365E-02,6.2239E-02, | |
37344 | &6.2062E-02,6.2731E-02,6.3942E-02,6.5526E-02,6.7390E-02,6.9436E-02, | |
37345 | &7.1635E-02,7.3891E-02,7.6122E-02,7.8246E-02,8.0196E-02,8.7884E-02, | |
37346 | &9.6357E-02,1.0648E-01,1.1880E-01,1.3413E-01,1.5386E-01,1.7993E-01, | |
37347 | &2.1655E-01,2.7189E-01,3.6486E-01,5.5332E-01,0.0000E+00,0.0000E+00, | |
37348 | &2.0271E+00,1.9234E+00,1.8224E+00,1.7226E+00,1.6272E+00,1.5293E+00/ | |
37349 | DATA (XSF_L(K),K= 1027, 1140) / | |
37350 | &1.4356E+00,1.3438E+00,1.2568E+00,1.1682E+00,1.0841E+00,1.0026E+00, | |
37351 | &9.2625E-01,8.8207E-01,8.3568E-01,7.8523E-01,7.3607E-01,6.8926E-01, | |
37352 | &6.4385E-01,6.0685E-01,5.6892E-01,5.2730E-01,4.8731E-01,4.4961E-01, | |
37353 | &4.1331E-01,3.8417E-01,3.5441E-01,3.2210E-01,2.9168E-01,2.6323E-01, | |
37354 | &2.3631E-01,2.1500E-01,1.9374E-01,1.7129E-01,1.5067E-01,1.3231E-01, | |
37355 | &1.1579E-01,1.0349E-01,9.2080E-02,8.1205E-02,7.2626E-02,6.8039E-02, | |
37356 | &6.4761E-02,6.3188E-02,6.2549E-02,6.2795E-02,6.3617E-02,6.4835E-02, | |
37357 | &6.6329E-02,6.8017E-02,6.9809E-02,7.1667E-02,7.3520E-02,7.5270E-02, | |
37358 | &7.6864E-02,8.3899E-02,9.1206E-02,1.0002E-01,1.1070E-01,1.2399E-01, | |
37359 | &1.4094E-01,1.6341E-01,1.9474E-01,2.4163E-01,3.1971E-01,4.7587E-01, | |
37360 | &0.0000E+00,0.0000E+00,2.4392E+00,2.3049E+00,2.1760E+00,2.0502E+00, | |
37361 | &1.9296E+00,1.8065E+00,1.6895E+00,1.5750E+00,1.4674E+00,1.3585E+00, | |
37362 | &1.2554E+00,1.1565E+00,1.0638E+00,1.0103E+00,9.5527E-01,8.9449E-01, | |
37363 | &8.3572E-01,7.8018E-01,7.2635E-01,6.8280E-01,6.3819E-01,5.8948E-01, | |
37364 | &5.4299E-01,4.9923E-01,4.5740E-01,4.2371E-01,3.8978E-01,3.5296E-01, | |
37365 | &3.1832E-01,2.8629E-01,2.5599E-01,2.3212E-01,2.0840E-01,1.8346E-01, | |
37366 | &1.6065E-01,1.4043E-01,1.2229E-01,1.0880E-01,9.6294E-02,8.4335E-02, | |
37367 | &7.4905E-02,6.9717E-02,6.5897E-02,6.3914E-02,6.2851E-02,6.2731E-02, | |
37368 | &6.3183E-02,6.4075E-02,6.5225E-02,6.6597E-02,6.8048E-02,6.9577E-02/ | |
37369 | DATA (XSF_L(K),K= 1141, 1254) / | |
37370 | &7.1093E-02,7.2525E-02,7.3842E-02,8.0241E-02,8.6615E-02,9.4292E-02, | |
37371 | &1.0360E-01,1.1517E-01,1.2992E-01,1.4936E-01,1.7633E-01,2.1652E-01, | |
37372 | &2.8294E-01,4.1389E-01,0.0000E+00,0.0000E+00,2.9162E+00,2.7470E+00, | |
37373 | &2.5840E+00,2.4244E+00,2.2743E+00,2.1215E+00,1.9764E+00,1.8358E+00, | |
37374 | &1.7035E+00,1.5708E+00,1.4463E+00,1.3268E+00,1.2152E+00,1.1514E+00, | |
37375 | &1.0857E+00,1.0132E+00,9.4449E-01,8.7867E-01,8.1556E-01,7.6453E-01, | |
37376 | &7.1252E-01,6.5602E-01,6.0218E-01,5.5192E-01,5.0387E-01,4.6545E-01, | |
37377 | &4.2679E-01,3.8521E-01,3.4602E-01,3.1005E-01,2.7623E-01,2.4962E-01, | |
37378 | &2.2332E-01,1.9577E-01,1.7070E-01,1.4856E-01,1.2874E-01,1.1402E-01, | |
37379 | &1.0040E-01,8.7343E-02,7.6984E-02,7.1254E-02,6.6892E-02,6.4508E-02, | |
37380 | &6.3019E-02,6.2518E-02,6.2667E-02,6.3211E-02,6.4031E-02,6.5064E-02, | |
37381 | &6.6243E-02,6.7458E-02,6.8679E-02,6.9830E-02,7.0885E-02,7.6672E-02, | |
37382 | &8.2192E-02,8.8844E-02,9.6930E-02,1.0696E-01,1.1972E-01,1.3654E-01, | |
37383 | &1.5978E-01,1.9411E-01,2.5048E-01,3.6023E-01,0.0000E+00,0.0000E+00, | |
37384 | &3.4281E+00,3.2194E+00,3.0180E+00,2.8239E+00,2.6400E+00,2.4537E+00, | |
37385 | &2.2781E+00,2.1087E+00,1.9503E+00,1.7915E+00,1.6433E+00,1.5021E+00, | |
37386 | &1.3711E+00,1.2958E+00,1.2191E+00,1.1350E+00,1.0536E+00,9.7846E-01, | |
37387 | &9.0526E-01,8.4668E-01,7.8697E-01,7.2243E-01,6.6110E-01,6.0402E-01, | |
37388 | &5.4971E-01,5.0652E-01,4.6307E-01,4.1647E-01,3.7287E-01,3.3288E-01/ | |
37389 | DATA (XSF_L(K),K= 1255, 1368) / | |
37390 | &2.9545E-01,2.6636E-01,2.3751E-01,2.0740E-01,1.8012E-01,1.5611E-01, | |
37391 | &1.3467E-01,1.1881E-01,1.0414E-01,9.0105E-02,7.8839E-02,7.2563E-02, | |
37392 | &6.7703E-02,6.4930E-02,6.3070E-02,6.2241E-02,6.2071E-02,6.2347E-02, | |
37393 | &6.2882E-02,6.3645E-02,6.4526E-02,6.5473E-02,6.6427E-02,6.7333E-02, | |
37394 | &6.8194E-02,7.3430E-02,7.8217E-02,8.3974E-02,9.1017E-02,9.9745E-02, | |
37395 | &1.1088E-01,1.2552E-01,1.4563E-01,1.7528E-01,2.2351E-01,3.1636E-01, | |
37396 | &0.0000E+00,0.0000E+00,3.9892E+00,3.7328E+00,3.4900E+00,3.2549E+00, | |
37397 | &3.0344E+00,2.8108E+00,2.6014E+00,2.4001E+00,2.2123E+00,2.0253E+00, | |
37398 | &1.8518E+00,1.6860E+00,1.5339E+00,1.4463E+00,1.3575E+00,1.2608E+00, | |
37399 | &1.1678E+00,1.0809E+00,9.9767E-01,9.3087E-01,8.6314E-01,7.8996E-01, | |
37400 | &7.2083E-01,6.5671E-01,5.9602E-01,5.4775E-01,4.9935E-01,4.4773E-01, | |
37401 | &3.9951E-01,3.5571E-01,3.1467E-01,2.8272E-01,2.5135E-01,2.1871E-01, | |
37402 | &1.8923E-01,1.6331E-01,1.4031E-01,1.2332E-01,1.0762E-01,9.2560E-02, | |
37403 | &8.0473E-02,7.3714E-02,6.8385E-02,6.5246E-02,6.3019E-02,6.1878E-02, | |
37404 | &6.1420E-02,6.1413E-02,6.1734E-02,6.2226E-02,6.2861E-02,6.3564E-02, | |
37405 | &6.4288E-02,6.4985E-02,6.5657E-02,7.0367E-02,7.4522E-02,7.9506E-02, | |
37406 | &8.5651E-02,9.3297E-02,1.0298E-01,1.1572E-01,1.3323E-01,1.5884E-01, | |
37407 | &2.0039E-01,2.7925E-01,0.0000E+00,0.0000E+00,4.5788E+00,4.2729E+00, | |
37408 | &3.9840E+00,3.7039E+00,3.4438E+00,3.1812E+00,2.9349E+00,2.6996E+00/ | |
37409 | DATA (XSF_L(K),K= 1369, 1482) / | |
37410 | &2.4810E+00,2.2644E+00,2.0633E+00,1.8732E+00,1.6979E+00,1.5988E+00, | |
37411 | &1.4974E+00,1.3865E+00,1.2812E+00,1.1834E+00,1.0891E+00,1.0143E+00, | |
37412 | &9.3839E-01,8.5662E-01,7.7948E-01,7.0838E-01,6.4106E-01,5.8780E-01, | |
37413 | &5.3454E-01,4.7781E-01,4.2528E-01,3.7737E-01,3.3289E-01,2.9818E-01, | |
37414 | &2.6446E-01,2.2932E-01,1.9770E-01,1.7005E-01,1.4552E-01,1.2746E-01, | |
37415 | &1.1078E-01,9.4770E-02,8.1957E-02,7.4689E-02,6.8915E-02,6.5457E-02, | |
37416 | &6.2902E-02,6.1493E-02,6.0768E-02,6.0515E-02,6.0585E-02,6.0863E-02, | |
37417 | &6.1298E-02,6.1789E-02,6.2311E-02,6.2835E-02,6.3340E-02,6.7601E-02, | |
37418 | &7.1162E-02,7.5516E-02,8.0878E-02,8.7566E-02,9.6095E-02,1.0725E-01, | |
37419 | &1.2258E-01,1.4495E-01,1.8090E-01,2.4841E-01,0.0000E+00,0.0000E+00, | |
37420 | &5.4774E+00,5.0929E+00,4.7320E+00,4.3841E+00,4.0592E+00,3.7350E+00, | |
37421 | &3.4329E+00,3.1454E+00,2.8799E+00,2.6172E+00,2.3747E+00,2.1466E+00, | |
37422 | &1.9383E+00,1.8195E+00,1.6996E+00,1.5689E+00,1.4457E+00,1.3301E+00, | |
37423 | &1.2211E+00,1.1339E+00,1.0456E+00,9.5119E-01,8.6259E-01,7.8097E-01, | |
37424 | &7.0419E-01,6.4380E-01,5.8358E-01,5.1955E-01,4.6051E-01,4.0719E-01, | |
37425 | &3.5768E-01,3.1962E-01,2.8220E-01,2.4360E-01,2.0909E-01,1.7895E-01, | |
37426 | &1.5240E-01,1.3282E-01,1.1484E-01,9.7655E-02,8.3739E-02,7.5857E-02, | |
37427 | &6.9509E-02,6.5616E-02,6.2633E-02,6.0853E-02,5.9819E-02,5.9271E-02, | |
37428 | &5.9038E-02,5.9046E-02,5.9192E-02,5.9432E-02,5.9709E-02,6.0008E-02/ | |
37429 | DATA (XSF_L(K),K= 1483, 1596) / | |
37430 | &6.0340E-02,6.4032E-02,6.6851E-02,7.0446E-02,7.4870E-02,8.0457E-02, | |
37431 | &8.7554E-02,9.6862E-02,1.0964E-01,1.2821E-01,1.5779E-01,2.1189E-01, | |
37432 | &0.0000E+00,0.0000E+00,6.3982E+00,5.9307E+00,5.4920E+00,5.0710E+00, | |
37433 | &4.6822E+00,4.2915E+00,3.9337E+00,3.5898E+00,3.2756E+00,2.9660E+00, | |
37434 | &2.6817E+00,2.4150E+00,2.1724E+00,2.0348E+00,1.8961E+00,1.7457E+00, | |
37435 | &1.6034E+00,1.4714E+00,1.3471E+00,1.2473E+00,1.1476E+00,1.0408E+00, | |
37436 | &9.4083E-01,8.4932E-01,7.6350E-01,6.9606E-01,6.2897E-01,5.5833E-01, | |
37437 | &4.9315E-01,4.3444E-01,3.8044E-01,3.3861E-01,2.9817E-01,2.5642E-01, | |
37438 | &2.1917E-01,1.8685E-01,1.5838E-01,1.3752E-01,1.1831E-01,9.9987E-02, | |
37439 | &8.5224E-02,7.6762E-02,6.9910E-02,6.5655E-02,6.2297E-02,6.0213E-02, | |
37440 | &5.8897E-02,5.8096E-02,5.7624E-02,5.7400E-02,5.7322E-02,5.7351E-02, | |
37441 | &5.7432E-02,5.7560E-02,5.7758E-02,6.0939E-02,6.3212E-02,6.6167E-02, | |
37442 | &6.9884E-02,7.4560E-02,8.0552E-02,8.8432E-02,9.9242E-02,1.1491E-01, | |
37443 | &1.3966E-01,1.8320E-01,0.0000E+00,0.0000E+00,7.4490E+00,6.8826E+00, | |
37444 | &6.3540E+00,5.8477E+00,5.3805E+00,4.9187E+00,4.4884E+00,4.0843E+00, | |
37445 | &3.7147E+00,3.3516E+00,3.0193E+00,2.7088E+00,2.4279E+00,2.2696E+00, | |
37446 | &2.1091E+00,1.9368E+00,1.7739E+00,1.6237E+00,1.4821E+00,1.3692E+00, | |
37447 | &1.2557E+00,1.1358E+00,1.0238E+00,9.2133E-01,8.2567E-01,7.5070E-01, | |
37448 | &6.7656E-01,5.9850E-01,5.2688E-01,4.6263E-01,4.0371E-01,3.5842E-01/ | |
37449 | DATA (XSF_L(K),K= 1597, 1710) / | |
37450 | &3.1427E-01,2.6933E-01,2.2930E-01,1.9466E-01,1.6427E-01,1.4208E-01, | |
37451 | &1.2168E-01,1.0226E-01,8.6560E-02,7.7553E-02,7.0202E-02,6.5576E-02, | |
37452 | &6.1860E-02,5.9487E-02,5.7920E-02,5.6852E-02,5.6166E-02,5.5736E-02, | |
37453 | &5.5458E-02,5.5289E-02,5.5193E-02,5.5163E-02,5.5243E-02,5.7935E-02, | |
37454 | &5.9740E-02,6.2111E-02,6.5158E-02,6.9050E-02,7.4078E-02,8.0683E-02, | |
37455 | &8.9776E-02,1.0288E-01,1.2351E-01,1.5725E-01,0.0000E+00,0.0000E+00, | |
37456 | &8.6044E+00,7.9255E+00,7.2940E+00,6.6940E+00,6.1391E+00,5.5940E+00, | |
37457 | &5.0907E+00,4.6180E+00,4.1841E+00,3.7622E+00,3.3775E+00,3.0195E+00, | |
37458 | &2.6967E+00,2.5153E+00,2.3331E+00,2.1364E+00,1.9521E+00,1.7815E+00, | |
37459 | &1.6211E+00,1.4944E+00,1.3683E+00,1.2334E+00,1.1084E+00,9.9465E-01, | |
37460 | &8.8864E-01,8.0585E-01,7.2432E-01,6.3866E-01,5.6038E-01,4.9058E-01, | |
37461 | &4.2648E-01,3.7768E-01,3.3036E-01,2.8189E-01,2.3907E-01,2.0214E-01, | |
37462 | &1.6987E-01,1.4635E-01,1.2479E-01,1.0428E-01,8.7748E-02,7.8203E-02, | |
37463 | &7.0386E-02,6.5431E-02,6.1373E-02,5.8719E-02,5.6916E-02,5.5642E-02, | |
37464 | &5.4751E-02,5.4118E-02,5.3653E-02,5.3314E-02,5.3067E-02,5.2897E-02, | |
37465 | &5.2861E-02,5.5140E-02,5.6493E-02,5.8378E-02,6.0860E-02,6.4090E-02, | |
37466 | &6.8261E-02,7.3828E-02,8.1439E-02,9.2423E-02,1.0952E-01,1.3424E-01, | |
37467 | &0.0000E+00,0.0000E+00,9.7645E+00,8.9701E+00,8.2340E+00,7.5357E+00, | |
37468 | &6.8926E+00,6.2607E+00,5.6834E+00,5.1374E+00,4.6459E+00,4.1625E+00/ | |
37469 | DATA (XSF_L(K),K= 1711, 1824) / | |
37470 | &3.7261E+00,3.3206E+00,2.9567E+00,2.7529E+00,2.5476E+00,2.3274E+00, | |
37471 | &2.1217E+00,1.9320E+00,1.7541E+00,1.6131E+00,1.4740E+00,1.3257E+00, | |
37472 | &1.1879E+00,1.0631E+00,9.4732E-01,8.5726E-01,7.6844E-01,6.7586E-01, | |
37473 | &5.9131E-01,5.1597E-01,4.4748E-01,3.9504E-01,3.4470E-01,2.9317E-01, | |
37474 | &2.4779E-01,2.0880E-01,1.7478E-01,1.5007E-01,1.2748E-01,1.0600E-01, | |
37475 | &8.8713E-02,7.8704E-02,7.0472E-02,6.5220E-02,6.0885E-02,5.7993E-02, | |
37476 | &5.5967E-02,5.4536E-02,5.3470E-02,5.2665E-02,5.2054E-02,5.1577E-02, | |
37477 | &5.1203E-02,5.0930E-02,5.0809E-02,5.2731E-02,5.3716E-02,5.5192E-02, | |
37478 | &5.7203E-02,5.9902E-02,6.3412E-02,6.8123E-02,7.4602E-02,8.3905E-02, | |
37479 | &9.8185E-02,1.1515E-01,0.0000E+00,0.0000E+00,1.1069E+01,1.0141E+01, | |
37480 | &9.2840E+00,8.4741E+00,7.7316E+00,7.0038E+00,6.3364E+00,5.7137E+00, | |
37481 | &5.1475E+00,4.6031E+00,4.1059E+00,3.6477E+00,3.2381E+00,3.0086E+00, | |
37482 | &2.7788E+00,2.5333E+00,2.3033E+00,2.0926E+00,1.8951E+00,1.7404E+00, | |
37483 | &1.5854E+00,1.4229E+00,1.2715E+00,1.1352E+00,1.0089E+00,9.1089E-01, | |
37484 | &8.1457E-01,7.1424E-01,6.2332E-01,5.4229E-01,4.6872E-01,4.1295E-01, | |
37485 | &3.5903E-01,3.0454E-01,2.5654E-01,2.1539E-01,1.7965E-01,1.5373E-01, | |
37486 | &1.3011E-01,1.0766E-01,8.9530E-02,7.9108E-02,7.0483E-02,6.4943E-02, | |
37487 | &6.0331E-02,5.7203E-02,5.4990E-02,5.3395E-02,5.2144E-02,5.1206E-02, | |
37488 | &5.0454E-02,4.9840E-02,4.9351E-02,4.8978E-02,4.8801E-02,5.0351E-02/ | |
37489 | DATA (XSF_L(K),K= 1825, 1836) / | |
37490 | &5.1017E-02,5.2127E-02,5.3737E-02,5.5934E-02,5.8835E-02,6.2800E-02, | |
37491 | &6.8260E-02,7.6135E-02,8.7873E-02,0.0000E+00,0.0000E+00,0.0000E+00/ | |
37492 | DATA (XGF_L(K),K= 1, 114) / | |
37493 | &1.0646E+00,1.0934E+00,1.1214E+00,1.1484E+00,1.1741E+00,1.1999E+00, | |
37494 | &1.2242E+00,1.2466E+00,1.2676E+00,1.2873E+00,1.3042E+00,1.3194E+00, | |
37495 | &1.3313E+00,1.3376E+00,1.3430E+00,1.3472E+00,1.3502E+00,1.3504E+00, | |
37496 | &1.3501E+00,1.3478E+00,1.3430E+00,1.3356E+00,1.3267E+00,1.3149E+00, | |
37497 | &1.3003E+00,1.2857E+00,1.2680E+00,1.2451E+00,1.2189E+00,1.1899E+00, | |
37498 | &1.1575E+00,1.1282E+00,1.0947E+00,1.0543E+00,1.0121E+00,9.6983E-01, | |
37499 | &9.2809E-01,8.9556E-01,8.6663E-01,8.4606E-01,8.4971E-01,8.7714E-01, | |
37500 | &9.3569E-01,1.0140E+00,1.1325E+00,1.2706E+00,1.4268E+00,1.6005E+00, | |
37501 | &1.7918E+00,2.0014E+00,2.2301E+00,2.4791E+00,2.7490E+00,3.0404E+00, | |
37502 | &3.3541E+00,3.5718E+00,4.2579E+00,5.0478E+00,5.9674E+00,7.0458E+00, | |
37503 | &8.3375E+00,9.9284E+00,1.1949E+01,1.4650E+01,1.8560E+01,2.5096E+01, | |
37504 | &4.0067E+01,0.0000E+00,1.6404E+00,1.6723E+00,1.7014E+00,1.7287E+00, | |
37505 | &1.7533E+00,1.7768E+00,1.7973E+00,1.8152E+00,1.8297E+00,1.8417E+00, | |
37506 | &1.8498E+00,1.8540E+00,1.8544E+00,1.8526E+00,1.8489E+00,1.8424E+00, | |
37507 | &1.8335E+00,1.8221E+00,1.8091E+00,1.7949E+00,1.7784E+00,1.7555E+00, | |
37508 | &1.7310E+00,1.7034E+00,1.6713E+00,1.6428E+00,1.6093E+00,1.5680E+00, | |
37509 | &1.5230E+00,1.4754E+00,1.4241E+00,1.3785E+00,1.3278E+00,1.2681E+00, | |
37510 | &1.2068E+00,1.1462E+00,1.0867E+00,1.0400E+00,9.9665E-01,9.6041E-01, | |
37511 | &9.4923E-01,9.6563E-01,1.0117E+00,1.0781E+00,1.1816E+00,1.3028E+00/ | |
37512 | DATA (XGF_L(K),K= 115, 228) / | |
37513 | &1.4397E+00,1.5912E+00,1.7573E+00,1.9376E+00,2.1326E+00,2.3425E+00, | |
37514 | &2.5677E+00,2.8078E+00,3.0611E+00,3.2398E+00,3.7904E+00,4.4126E+00, | |
37515 | &5.1162E+00,5.9322E+00,6.8841E+00,8.0278E+00,9.4403E+00,1.1276E+01, | |
37516 | &1.3844E+01,1.7948E+01,2.6821E+01,0.0000E+00,2.5295E+00,2.5563E+00, | |
37517 | &2.5800E+00,2.5995E+00,2.6174E+00,2.6286E+00,2.6363E+00,2.6395E+00, | |
37518 | &2.6379E+00,2.6306E+00,2.6184E+00,2.6000E+00,2.5768E+00,2.5598E+00, | |
37519 | &2.5397E+00,2.5137E+00,2.4839E+00,2.4516E+00,2.4161E+00,2.3833E+00, | |
37520 | &2.3459E+00,2.3000E+00,2.2499E+00,2.1966E+00,2.1407E+00,2.0900E+00, | |
37521 | &2.0320E+00,1.9647E+00,1.8929E+00,1.8190E+00,1.7411E+00,1.6734E+00, | |
37522 | &1.5997E+00,1.5142E+00,1.4279E+00,1.3438E+00,1.2617E+00,1.1967E+00, | |
37523 | &1.1353E+00,1.0800E+00,1.0501E+00,1.0526E+00,1.0849E+00,1.1369E+00, | |
37524 | &1.2228E+00,1.3250E+00,1.4410E+00,1.5691E+00,1.7085E+00,1.8587E+00, | |
37525 | &2.0200E+00,2.1915E+00,2.3728E+00,2.5633E+00,2.7603E+00,2.9047E+00, | |
37526 | &3.3315E+00,3.8026E+00,4.3243E+00,4.9121E+00,5.5828E+00,6.3648E+00, | |
37527 | &7.3038E+00,8.4817E+00,1.0068E+01,1.2484E+01,1.7398E+01,0.0000E+00, | |
37528 | &3.9781E+00,3.9859E+00,3.9880E+00,3.9845E+00,3.9763E+00,3.9582E+00, | |
37529 | &3.9337E+00,3.9028E+00,3.8636E+00,3.8159E+00,3.7613E+00,3.6984E+00, | |
37530 | &3.6287E+00,3.5836E+00,3.5326E+00,3.4703E+00,3.4046E+00,3.3350E+00, | |
37531 | &3.2612E+00,3.1962E+00,3.1248E+00,3.0388E+00,2.9485E+00,2.8565E+00/ | |
37532 | DATA (XGF_L(K),K= 229, 342) / | |
37533 | &2.7591E+00,2.6752E+00,2.5823E+00,2.4756E+00,2.3627E+00,2.2510E+00, | |
37534 | &2.1352E+00,2.0365E+00,1.9308E+00,1.8097E+00,1.6896E+00,1.5737E+00, | |
37535 | &1.4618E+00,1.3735E+00,1.2886E+00,1.2087E+00,1.1551E+00,1.1411E+00, | |
37536 | &1.1545E+00,1.1903E+00,1.2550E+00,1.3356E+00,1.4282E+00,1.5306E+00, | |
37537 | &1.6419E+00,1.7606E+00,1.8869E+00,2.0194E+00,2.1574E+00,2.2992E+00, | |
37538 | &2.4432E+00,2.5568E+00,2.8674E+00,3.2008E+00,3.5626E+00,3.9572E+00, | |
37539 | &4.3932E+00,4.8857E+00,5.4544E+00,6.1386E+00,7.0188E+00,8.2895E+00, | |
37540 | &1.0709E+01,0.0000E+00,6.3697E+00,6.3265E+00,6.2740E+00,6.2091E+00, | |
37541 | &6.1391E+00,6.0517E+00,5.9560E+00,5.8525E+00,5.7367E+00,5.6106E+00, | |
37542 | &5.4709E+00,5.3235E+00,5.1695E+00,5.0724E+00,4.9662E+00,4.8411E+00, | |
37543 | &4.7105E+00,4.5784E+00,4.4412E+00,4.3226E+00,4.1943E+00,4.0442E+00, | |
37544 | &3.8903E+00,3.7360E+00,3.5773E+00,3.4420E+00,3.2967E+00,3.1301E+00, | |
37545 | &2.9593E+00,2.7916E+00,2.6229E+00,2.4802E+00,2.3301E+00,2.1613E+00, | |
37546 | &1.9957E+00,1.8382E+00,1.6875E+00,1.5691E+00,1.4545E+00,1.3433E+00, | |
37547 | &1.2614E+00,1.2264E+00,1.2177E+00,1.2342E+00,1.2749E+00,1.3313E+00, | |
37548 | &1.3987E+00,1.4740E+00,1.5559E+00,1.6431E+00,1.7346E+00,1.8295E+00, | |
37549 | &1.9260E+00,2.0232E+00,2.1174E+00,2.2034E+00,2.4118E+00,2.6289E+00, | |
37550 | &2.8563E+00,3.0948E+00,3.3486E+00,3.6231E+00,3.9250E+00,4.2677E+00, | |
37551 | &4.6847E+00,5.2492E+00,6.2650E+00,0.0000E+00,9.3778E+00,9.2428E+00/ | |
37552 | DATA (XGF_L(K),K= 343, 456) / | |
37553 | &9.0960E+00,8.9365E+00,8.7665E+00,8.5746E+00,8.3714E+00,8.1544E+00, | |
37554 | &7.9343E+00,7.6882E+00,7.4352E+00,7.1724E+00,6.9027E+00,6.7360E+00, | |
37555 | &6.5571E+00,6.3494E+00,6.1374E+00,5.9260E+00,5.7093E+00,5.5249E+00, | |
37556 | &5.3270E+00,5.0995E+00,4.8700E+00,4.6419E+00,4.4114E+00,4.2173E+00, | |
37557 | &4.0129E+00,3.7786E+00,3.5451E+00,3.3173E+00,3.0900E+00,2.9004E+00, | |
37558 | &2.7040E+00,2.4853E+00,2.2734E+00,2.0742E+00,1.8851E+00,1.7372E+00, | |
37559 | &1.5941E+00,1.4536E+00,1.3433E+00,1.2893E+00,1.2607E+00,1.2587E+00, | |
37560 | &1.2792E+00,1.3153E+00,1.3616E+00,1.4149E+00,1.4736E+00,1.5361E+00, | |
37561 | &1.6012E+00,1.6677E+00,1.7344E+00,1.7990E+00,1.8589E+00,1.9261E+00, | |
37562 | &2.0646E+00,2.2044E+00,2.3456E+00,2.4882E+00,2.6342E+00,2.7823E+00, | |
37563 | &2.9370E+00,3.1022E+00,3.2902E+00,3.5288E+00,3.9528E+00,0.0000E+00, | |
37564 | &1.3926E+01,1.3617E+01,1.3298E+01,1.2959E+01,1.2612E+01,1.2230E+01, | |
37565 | &1.1845E+01,1.1442E+01,1.1036E+01,1.0599E+01,1.0158E+01,9.7041E+00, | |
37566 | &9.2562E+00,8.9827E+00,8.6974E+00,8.3632E+00,8.0255E+00,7.6946E+00, | |
37567 | &7.3614E+00,7.0802E+00,6.7814E+00,6.4439E+00,6.1064E+00,5.7775E+00, | |
37568 | &5.4468E+00,5.1723E+00,4.8858E+00,4.5617E+00,4.2425E+00,3.9361E+00, | |
37569 | &3.6353E+00,3.3874E+00,3.1301E+00,2.8506E+00,2.5816E+00,2.3318E+00, | |
37570 | &2.0965E+00,1.9136E+00,1.7368E+00,1.5622E+00,1.4211E+00,1.3452E+00, | |
37571 | &1.2937E+00,1.2737E+00,1.2719E+00,1.2868E+00,1.3119E+00,1.3437E+00/ | |
37572 | DATA (XGF_L(K),K= 457, 570) / | |
37573 | &1.3799E+00,1.4189E+00,1.4596E+00,1.5003E+00,1.5401E+00,1.5761E+00, | |
37574 | &1.6073E+00,1.6574E+00,1.7377E+00,1.8158E+00,1.8902E+00,1.9601E+00, | |
37575 | &2.0263E+00,2.0884E+00,2.1452E+00,2.1990E+00,2.2512E+00,2.3118E+00, | |
37576 | &2.4354E+00,0.0000E+00,1.9256E+01,1.8699E+01,1.8142E+01,1.7563E+01, | |
37577 | &1.6980E+01,1.6355E+01,1.5725E+01,1.5081E+01,1.4443E+01,1.3769E+01, | |
37578 | &1.3097E+01,1.2422E+01,1.1755E+01,1.1358E+01,1.0937E+01,1.0454E+01, | |
37579 | &9.9818E+00,9.5167E+00,9.0465E+00,8.6570E+00,8.2473E+00,7.7870E+00, | |
37580 | &7.3320E+00,6.8911E+00,6.4569E+00,6.0969E+00,5.7223E+00,5.3051E+00, | |
37581 | &4.8992E+00,4.5131E+00,4.1351E+00,3.8285E+00,3.5148E+00,3.1749E+00, | |
37582 | &2.8517E+00,2.5534E+00,2.2748E+00,2.0598E+00,1.8527E+00,1.6465E+00, | |
37583 | &1.4780E+00,1.3832E+00,1.3129E+00,1.2758E+00,1.2566E+00,1.2544E+00, | |
37584 | &1.2628E+00,1.2778E+00,1.2971E+00,1.3186E+00,1.3412E+00,1.3637E+00, | |
37585 | &1.3845E+00,1.4021E+00,1.4142E+00,1.4518E+00,1.4945E+00,1.5327E+00, | |
37586 | &1.5661E+00,1.5941E+00,1.6160E+00,1.6309E+00,1.6386E+00,1.6381E+00, | |
37587 | &1.6291E+00,1.6176E+00,1.6271E+00,0.0000E+00,2.5945E+01,2.5063E+01, | |
37588 | &2.4160E+01,2.3234E+01,2.2336E+01,2.1370E+01,2.0417E+01,1.9450E+01, | |
37589 | &1.8508E+01,1.7517E+01,1.6548E+01,1.5580E+01,1.4645E+01,1.4085E+01, | |
37590 | &1.3496E+01,1.2836E+01,1.2181E+01,1.1547E+01,1.0921E+01,1.0404E+01, | |
37591 | &9.8614E+00,9.2547E+00,8.6616E+00,8.0926E+00,7.5352E+00,7.0774E+00/ | |
37592 | DATA (XGF_L(K),K= 571, 684) / | |
37593 | &6.6043E+00,6.0842E+00,5.5816E+00,5.1040E+00,4.6450E+00,4.2749E+00, | |
37594 | &3.8995E+00,3.4941E+00,3.1134E+00,2.7651E+00,2.4423E+00,2.1941E+00, | |
37595 | &1.9564E+00,1.7198E+00,1.5241E+00,1.4112E+00,1.3220E+00,1.2705E+00, | |
37596 | &1.2348E+00,1.2175E+00,1.2113E+00,1.2119E+00,1.2167E+00,1.2238E+00, | |
37597 | &1.2321E+00,1.2398E+00,1.2460E+00,1.2491E+00,1.2470E+00,1.2752E+00, | |
37598 | &1.2894E+00,1.2998E+00,1.3055E+00,1.3049E+00,1.2991E+00,1.2860E+00, | |
37599 | &1.2655E+00,1.2370E+00,1.1998E+00,1.1564E+00,1.1181E+00,0.0000E+00, | |
37600 | &3.3362E+01,3.2051E+01,3.0740E+01,2.9429E+01,2.8133E+01,2.6758E+01, | |
37601 | &2.5422E+01,2.4082E+01,2.2784E+01,2.1435E+01,2.0130E+01,1.8839E+01, | |
37602 | &1.7597E+01,1.6865E+01,1.6098E+01,1.5241E+01,1.4397E+01,1.3587E+01, | |
37603 | &1.2791E+01,1.2130E+01,1.1444E+01,1.0687E+01,9.9507E+00,9.2501E+00, | |
37604 | &8.5659E+00,8.0104E+00,7.4390E+00,6.8118E+00,6.2125E+00,5.6506E+00, | |
37605 | &5.1096E+00,4.6780E+00,4.2434E+00,3.7769E+00,3.3424E+00,2.9475E+00, | |
37606 | &2.5842E+00,2.3061E+00,2.0409E+00,1.7770E+00,1.5572E+00,1.4290E+00, | |
37607 | &1.3248E+00,1.2609E+00,1.2112E+00,1.1814E+00,1.1636E+00,1.1530E+00, | |
37608 | &1.1469E+00,1.1433E+00,1.1407E+00,1.1378E+00,1.1337E+00,1.1269E+00, | |
37609 | &1.1152E+00,1.1360E+00,1.1320E+00,1.1243E+00,1.1127E+00,1.0960E+00, | |
37610 | &1.0739E+00,1.0461E+00,1.0122E+00,9.7100E-01,9.2292E-01,8.6909E-01, | |
37611 | &8.1432E-01,0.0000E+00,4.2364E+01,4.0483E+01,3.8640E+01,3.6792E+01/ | |
37612 | DATA (XGF_L(K),K= 685, 798) / | |
37613 | &3.4991E+01,3.3112E+01,3.1295E+01,2.9487E+01,2.7748E+01,2.5953E+01, | |
37614 | &2.4235E+01,2.2543E+01,2.0935E+01,1.9990E+01,1.9011E+01,1.7921E+01, | |
37615 | &1.6852E+01,1.5830E+01,1.4831E+01,1.4013E+01,1.3165E+01,1.2236E+01, | |
37616 | &1.1337E+01,1.0485E+01,9.6616E+00,8.9943E+00,8.3137E+00,7.5711E+00, | |
37617 | &6.8670E+00,6.2090E+00,5.5842E+00,5.0866E+00,4.5873E+00,4.0564E+00, | |
37618 | &3.5646E+00,3.1234E+00,2.7185E+00,2.4107E+00,2.1172E+00,1.8273E+00, | |
37619 | &1.5836E+00,1.4407E+00,1.3211E+00,1.2459E+00,1.1839E+00,1.1433E+00, | |
37620 | &1.1153E+00,1.0949E+00,1.0794E+00,1.0667E+00,1.0555E+00,1.0443E+00, | |
37621 | &1.0317E+00,1.0172E+00,9.9883E-01,1.0131E+00,9.9503E-01,9.7446E-01, | |
37622 | &9.5064E-01,9.2316E-01,8.9156E-01,8.5528E-01,8.1439E-01,7.6837E-01, | |
37623 | &7.1718E-01,6.6210E-01,6.0243E-01,0.0000E+00,5.2603E+01,5.0038E+01, | |
37624 | &4.7540E+01,4.5053E+01,4.2652E+01,4.0175E+01,3.7784E+01,3.5407E+01, | |
37625 | &3.3154E+01,3.0851E+01,2.8651E+01,2.6507E+01,2.4488E+01,2.3310E+01, | |
37626 | &2.2084E+01,2.0735E+01,1.9418E+01,1.8166E+01,1.6951E+01,1.5960E+01, | |
37627 | &1.4935E+01,1.3817E+01,1.2742E+01,1.1732E+01,1.0759E+01,9.9749E+00, | |
37628 | &9.1794E+00,8.3186E+00,7.5044E+00,6.7510E+00,6.0386E+00,5.4762E+00, | |
37629 | &4.9137E+00,4.3200E+00,3.7728E+00,3.2842E+00,2.8391E+00,2.5026E+00, | |
37630 | &2.1835E+00,1.8677E+00,1.6033E+00,1.4461E+00,1.3138E+00,1.2277E+00, | |
37631 | &1.1557E+00,1.1057E+00,1.0689E+00,1.0407E+00,1.0176E+00,9.9768E-01/ | |
37632 | DATA (XGF_L(K),K= 799, 912) / | |
37633 | &9.7951E-01,9.6199E-01,9.4331E-01,9.2359E-01,9.0058E-01,9.0921E-01, | |
37634 | &8.8156E-01,8.5244E-01,8.2081E-01,7.8702E-01,7.5025E-01,7.1005E-01, | |
37635 | &6.6667E-01,6.1984E-01,5.6969E-01,5.1748E-01,4.5895E-01,0.0000E+00, | |
37636 | &6.3459E+01,6.0127E+01,5.6900E+01,5.3695E+01,5.0615E+01,4.7464E+01, | |
37637 | &4.4440E+01,4.1483E+01,3.8684E+01,3.5826E+01,3.3122E+01,3.0500E+01, | |
37638 | &2.8040E+01,2.6617E+01,2.5143E+01,2.3518E+01,2.1950E+01,2.0455E+01, | |
37639 | &1.9011E+01,1.7842E+01,1.6646E+01,1.5337E+01,1.4094E+01,1.2920E+01, | |
37640 | &1.1799E+01,1.0903E+01,9.9940E+00,9.0166E+00,8.0967E+00,7.2512E+00, | |
37641 | &6.4551E+00,5.8279E+00,5.2081E+00,4.5519E+00,3.9568E+00,3.4237E+00, | |
37642 | &2.9425E+00,2.5798E+00,2.2371E+00,1.8995E+00,1.6161E+00,1.4477E+00, | |
37643 | &1.3046E+00,1.2096E+00,1.1285E+00,1.0709E+00,1.0274E+00,9.9290E-01, | |
37644 | &9.6399E-01,9.3860E-01,9.1550E-01,8.9324E-01,8.7036E-01,8.4674E-01, | |
37645 | &8.2129E-01,8.2506E-01,7.9094E-01,7.5633E-01,7.2031E-01,6.8307E-01, | |
37646 | &6.4387E-01,6.0237E-01,5.5907E-01,5.1344E-01,4.6618E-01,4.1810E-01, | |
37647 | &3.6329E-01,0.0000E+00,7.9498E+01,7.4941E+01,7.0580E+01,6.6266E+01, | |
37648 | &6.2169E+01,5.8002E+01,5.4045E+01,5.0164E+01,4.6539E+01,4.2847E+01, | |
37649 | &3.9386E+01,3.6065E+01,3.2968E+01,3.1180E+01,2.9347E+01,2.7330E+01, | |
37650 | &2.5394E+01,2.3566E+01,2.1811E+01,2.0388E+01,1.8944E+01,1.7368E+01, | |
37651 | &1.5877E+01,1.4488E+01,1.3164E+01,1.2111E+01,1.1051E+01,9.9162E+00/ | |
37652 | DATA (XGF_L(K),K= 913, 1026) / | |
37653 | &8.8542E+00,7.8839E+00,6.9777E+00,6.2689E+00,5.5695E+00,4.8410E+00, | |
37654 | &4.1789E+00,3.5909E+00,3.0635E+00,2.6689E+00,2.2973E+00,1.9324E+00, | |
37655 | &1.6270E+00,1.4446E+00,1.2882E+00,1.1839E+00,1.0926E+00,1.0266E+00, | |
37656 | &9.7585E-01,9.3473E-01,8.9976E-01,8.6898E-01,8.4068E-01,8.1374E-01, | |
37657 | &7.8714E-01,7.6011E-01,7.3262E-01,7.3148E-01,6.9170E-01,6.5270E-01, | |
37658 | &6.1357E-01,5.7426E-01,5.3417E-01,4.9316E-01,4.5166E-01,4.0914E-01, | |
37659 | &3.6649E-01,3.2429E-01,2.7651E-01,0.0000E+00,9.7091E+01,9.1127E+01, | |
37660 | &8.5440E+01,7.9869E+01,7.4603E+01,6.9275E+01,6.4220E+01,5.9343E+01, | |
37661 | &5.4780E+01,5.0195E+01,4.5912E+01,4.1816E+01,3.8028E+01,3.5857E+01, | |
37662 | &3.3637E+01,3.1205E+01,2.8880E+01,2.6695E+01,2.4601E+01,2.2923E+01, | |
37663 | &2.1219E+01,1.9374E+01,1.7634E+01,1.6009E+01,1.4488E+01,1.3276E+01, | |
37664 | &1.2064E+01,1.0772E+01,9.5709E+00,8.4795E+00,7.4649E+00,6.6775E+00, | |
37665 | &5.9046E+00,5.1015E+00,4.3733E+00,3.7372E+00,3.1677E+00,2.7434E+00, | |
37666 | &2.3459E+00,1.9566E+00,1.6317E+00,1.4368E+00,1.2699E+00,1.1572E+00, | |
37667 | &1.0581E+00,9.8558E-01,9.2913E-01,8.8297E-01,8.4349E-01,8.0862E-01, | |
37668 | &7.7667E-01,7.4686E-01,7.1760E-01,6.8906E-01,6.6005E-01,6.5493E-01, | |
37669 | &6.1209E-01,5.7080E-01,5.3038E-01,4.9085E-01,4.5137E-01,4.1231E-01, | |
37670 | &3.7316E-01,3.3442E-01,2.9613E-01,2.5928E-01,2.1912E-01,0.0000E+00, | |
37671 | &1.1660E+02,1.0899E+02,1.0178E+02,9.4752E+01,8.8142E+01,8.1480E+01/ | |
37672 | DATA (XGF_L(K),K= 1027, 1140) / | |
37673 | &7.5219E+01,6.9198E+01,6.3578E+01,5.7986E+01,5.2800E+01,4.7867E+01, | |
37674 | &4.3328E+01,4.0736E+01,3.8088E+01,3.5213E+01,3.2469E+01,2.9907E+01, | |
37675 | &2.7451E+01,2.5501E+01,2.3516E+01,2.1392E+01,1.9391E+01,1.7546E+01, | |
37676 | &1.5800E+01,1.4426E+01,1.3057E+01,1.1607E+01,1.0266E+01,9.0517E+00, | |
37677 | &7.9294E+00,7.0617E+00,6.2165E+00,5.3397E+00,4.5572E+00,3.8687E+00, | |
37678 | &3.2598E+00,2.8078E+00,2.3859E+00,1.9745E+00,1.6317E+00,1.4267E+00, | |
37679 | &1.2497E+00,1.1305E+00,1.0247E+00,9.4657E-01,8.8556E-01,8.3542E-01, | |
37680 | &7.9253E-01,7.5465E-01,7.2037E-01,6.8840E-01,6.5775E-01,6.2793E-01, | |
37681 | &5.9852E-01,5.9015E-01,5.4553E-01,5.0339E-01,4.6306E-01,4.2411E-01, | |
37682 | &3.8622E-01,3.4909E-01,3.1294E-01,2.7773E-01,2.4373E-01,2.1150E-01, | |
37683 | &1.7848E-01,0.0000E+00,1.3738E+02,1.2796E+02,1.1904E+02,1.1042E+02, | |
37684 | &1.0233E+02,9.4222E+01,8.6662E+01,7.9409E+01,7.2655E+01,6.6001E+01, | |
37685 | &5.9833E+01,5.4007E+01,4.8672E+01,4.5642E+01,4.2552E+01,3.9214E+01, | |
37686 | &3.6040E+01,3.3082E+01,3.0272E+01,2.8026E+01,2.5779E+01,2.3361E+01, | |
37687 | &2.1093E+01,1.9009E+01,1.7062E+01,1.5526E+01,1.4003E+01,1.2396E+01, | |
37688 | &1.0916E+01,9.5845E+00,8.3611E+00,7.4188E+00,6.5021E+00,5.5589E+00, | |
37689 | &4.7169E+00,3.9865E+00,3.3389E+00,2.8617E+00,2.4178E+00,1.9872E+00, | |
37690 | &1.6283E+00,1.4143E+00,1.2296E+00,1.1049E+00,9.9315E-01,9.1079E-01, | |
37691 | &8.4623E-01,7.9317E-01,7.4768E-01,7.0802E-01,6.7178E-01,6.3836E-01/ | |
37692 | DATA (XGF_L(K),K= 1141, 1254) / | |
37693 | &6.0703E-01,5.7658E-01,5.4733E-01,5.3630E-01,4.9100E-01,4.4879E-01, | |
37694 | &4.0920E-01,3.7138E-01,3.3521E-01,3.0054E-01,2.6721E-01,2.3523E-01, | |
37695 | &2.0485E-01,1.7634E-01,1.4852E-01,0.0000E+00,1.6103E+02,1.4938E+02, | |
37696 | &1.3848E+02,1.2798E+02,1.1818E+02,1.0840E+02,9.9309E+01,9.0651E+01, | |
37697 | &8.2647E+01,7.4733E+01,6.7469E+01,6.0672E+01,5.4433E+01,5.0913E+01, | |
37698 | &4.7343E+01,4.3482E+01,3.9833E+01,3.6452E+01,3.3242E+01,3.0689E+01, | |
37699 | &2.8134E+01,2.5404E+01,2.2863E+01,2.0531E+01,1.8362E+01,1.6652E+01, | |
37700 | &1.4967E+01,1.3197E+01,1.1573E+01,1.0120E+01,8.7877E+00,7.7679E+00, | |
37701 | &6.7819E+00,5.7685E+00,4.8731E+00,4.0967E+00,3.4122E+00,2.9097E+00, | |
37702 | &2.4451E+00,1.9953E+00,1.6222E+00,1.3995E+00,1.2076E+00,1.0771E+00, | |
37703 | &9.6151E-01,8.7563E-01,8.0819E-01,7.5269E-01,7.0548E-01,6.6395E-01, | |
37704 | &6.2666E-01,5.9253E-01,5.6034E-01,5.3005E-01,5.0122E-01,4.8790E-01, | |
37705 | &4.4273E-01,4.0115E-01,3.6251E-01,3.2632E-01,2.9224E-01,2.5988E-01, | |
37706 | &2.2931E-01,2.0039E-01,1.7324E-01,1.4805E-01,1.2201E-01,0.0000E+00, | |
37707 | &1.8591E+02,1.7193E+02,1.5886E+02,1.4632E+02,1.3469E+02,1.2310E+02, | |
37708 | &1.1237E+02,1.0218E+02,9.2839E+01,8.3643E+01,7.5256E+01,6.7382E+01, | |
37709 | &6.0231E+01,5.6204E+01,5.2127E+01,4.7743E+01,4.3601E+01,3.9784E+01, | |
37710 | &3.6172E+01,3.3310E+01,3.0455E+01,2.7410E+01,2.4579E+01,2.2009E+01, | |
37711 | &1.9599E+01,1.7727E+01,1.5886E+01,1.3956E+01,1.2193E+01,1.0620E+01/ | |
37712 | DATA (XGF_L(K),K= 1255, 1368) / | |
37713 | &9.1866E+00,8.0925E+00,7.0383E+00,5.9623E+00,5.0119E+00,4.1917E+00, | |
37714 | &3.4750E+00,2.9503E+00,2.4663E+00,1.9999E+00,1.6141E+00,1.3840E+00, | |
37715 | &1.1856E+00,1.0518E+00,9.3192E-01,8.4324E-01,7.7348E-01,7.1642E-01, | |
37716 | &6.6779E-01,6.2531E-01,5.8732E-01,5.5231E-01,5.2039E-01,4.9037E-01, | |
37717 | &4.6218E-01,4.4711E-01,4.0225E-01,3.6159E-01,3.2438E-01,2.8982E-01, | |
37718 | &2.5765E-01,2.2765E-01,1.9954E-01,1.7331E-01,1.4889E-01,1.2621E-01, | |
37719 | &9.6984E-02,0.0000E+00,2.1269E+02,1.9609E+02,1.8060E+02,1.6582E+02, | |
37720 | &1.5214E+02,1.3863E+02,1.2613E+02,1.1431E+02,1.0351E+02,9.2957E+01, | |
37721 | &8.3294E+01,7.4318E+01,6.6188E+01,6.1617E+01,5.7019E+01,5.2073E+01, | |
37722 | &4.7428E+01,4.3153E+01,3.9122E+01,3.5941E+01,3.2764E+01,2.9404E+01, | |
37723 | &2.6282E+01,2.3458E+01,2.0836E+01,1.8796E+01,1.6786E+01,1.4693E+01, | |
37724 | &1.2792E+01,1.1101E+01,9.5678E+00,8.4010E+00,7.2773E+00,6.1402E+00, | |
37725 | &5.1403E+00,4.2791E+00,3.5311E+00,2.9851E+00,2.4835E+00,2.0017E+00, | |
37726 | &1.6039E+00,1.3677E+00,1.1646E+00,1.0265E+00,9.0375E-01,8.1271E-01, | |
37727 | &7.4135E-01,6.8280E-01,6.3328E-01,5.9018E-01,5.5184E-01,5.1677E-01, | |
37728 | &4.8494E-01,4.5537E-01,4.2797E-01,4.1146E-01,3.6736E-01,3.2788E-01, | |
37729 | &2.9207E-01,2.5923E-01,2.2901E-01,2.0110E-01,1.7527E-01,1.5131E-01, | |
37730 | &1.2926E-01,1.0839E-01,6.9776E-02,0.0000E+00,2.4043E+02,2.2104E+02, | |
37731 | &2.0300E+02,1.8582E+02,1.7003E+02,1.5443E+02,1.4007E+02,1.2658E+02/ | |
37732 | DATA (XGF_L(K),K= 1369, 1482) / | |
37733 | &1.1426E+02,1.0227E+02,9.1332E+01,8.1197E+01,7.2119E+01,6.6989E+01, | |
37734 | &6.1846E+01,5.6342E+01,5.1188E+01,4.6448E+01,4.2002E+01,3.8498E+01, | |
37735 | &3.5016E+01,3.1335E+01,2.7931E+01,2.4848E+01,2.2009E+01,1.9797E+01, | |
37736 | &1.7637E+01,1.5389E+01,1.3354E+01,1.1550E+01,9.9187E+00,8.6824E+00, | |
37737 | &7.4988E+00,6.3022E+00,5.2549E+00,4.3589E+00,3.5788E+00,3.0139E+00, | |
37738 | &2.4962E+00,2.0005E+00,1.5931E+00,1.3514E+00,1.1435E+00,1.0028E+00, | |
37739 | &8.7751E-01,7.8479E-01,7.1218E-01,6.5272E-01,6.0250E-01,5.5920E-01, | |
37740 | &5.2061E-01,4.8590E-01,4.5422E-01,4.2519E-01,3.9858E-01,3.8094E-01, | |
37741 | &3.3789E-01,2.9975E-01,2.6524E-01,2.3401E-01,2.0560E-01,1.7956E-01, | |
37742 | &1.5565E-01,1.3374E-01,1.1354E-01,9.4096E-02,3.9275E-02,0.0000E+00, | |
37743 | &2.8195E+02,2.5830E+02,2.3640E+02,2.1554E+02,1.9645E+02,1.7774E+02, | |
37744 | &1.6058E+02,1.4448E+02,1.2990E+02,1.1575E+02,1.0299E+02,9.1121E+01, | |
37745 | &8.0574E+01,7.4642E+01,6.8724E+01,6.2402E+01,5.6498E+01,5.1101E+01, | |
37746 | &4.6042E+01,4.2081E+01,3.8152E+01,3.4014E+01,3.0201E+01,2.6780E+01, | |
37747 | &2.3611E+01,2.1171E+01,1.8789E+01,1.6329E+01,1.4107E+01,1.2148E+01, | |
37748 | &1.0386E+01,9.0557E+00,7.7874E+00,6.5118E+00,5.4006E+00,4.4539E+00, | |
37749 | &3.6370E+00,3.0467E+00,2.5088E+00,1.9959E+00,1.5762E+00,1.3274E+00, | |
37750 | &1.1142E+00,9.7065E-01,8.4265E-01,7.4825E-01,6.7451E-01,6.1445E-01, | |
37751 | &5.6374E-01,5.2024E-01,4.8166E-01,4.4741E-01,4.1643E-01,3.8830E-01/ | |
37752 | DATA (XGF_L(K),K= 1483, 1596) / | |
37753 | &3.6282E-01,3.4411E-01,3.0249E-01,2.6607E-01,2.3369E-01,2.0474E-01, | |
37754 | &1.7852E-01,1.5489E-01,1.3341E-01,1.1384E-01,9.5862E-02,7.7509E-02, | |
37755 | &0.0000E+00,0.0000E+00,3.2379E+02,2.9556E+02,2.6960E+02,2.4513E+02, | |
37756 | &2.2265E+02,2.0073E+02,1.8071E+02,1.6202E+02,1.4515E+02,1.2887E+02, | |
37757 | &1.1419E+02,1.0071E+02,8.8650E+01,8.1931E+01,7.5233E+01,6.8140E+01, | |
37758 | &6.1510E+01,5.5467E+01,4.9832E+01,4.5419E+01,4.1070E+01,3.6493E+01, | |
37759 | &3.2295E+01,2.8536E+01,2.5086E+01,2.2426E+01,1.9846E+01,1.7175E+01, | |
37760 | &1.4781E+01,1.2681E+01,1.0797E+01,9.3831E+00,8.0380E+00,6.6897E+00, | |
37761 | &5.5221E+00,4.5337E+00,3.6831E+00,3.0714E+00,2.5159E+00,1.9884E+00, | |
37762 | &1.5586E+00,1.3048E+00,1.0886E+00,9.4191E-01,8.1217E-01,7.1679E-01, | |
37763 | &6.4238E-01,5.8194E-01,5.3136E-01,4.8766E-01,4.4965E-01,4.1594E-01, | |
37764 | &3.8570E-01,3.5847E-01,3.3403E-01,3.1456E-01,2.7454E-01,2.3977E-01, | |
37765 | &2.0922E-01,1.8216E-01,1.5795E-01,1.3622E-01,1.1669E-01,9.9012E-02, | |
37766 | &8.2668E-02,6.4604E-02,0.0000E+00,0.0000E+00,3.7071E+02,3.3727E+02, | |
37767 | &3.0660E+02,2.7790E+02,2.5169E+02,2.2608E+02,2.0283E+02,1.8123E+02, | |
37768 | &1.6179E+02,1.4311E+02,1.2635E+02,1.1097E+02,9.7357E+01,8.9759E+01, | |
37769 | &8.2263E+01,7.4239E+01,6.6821E+01,6.0073E+01,5.3813E+01,4.8927E+01, | |
37770 | &4.4114E+01,3.9072E+01,3.4471E+01,3.0351E+01,2.6592E+01,2.3699E+01, | |
37771 | &2.0903E+01,1.8031E+01,1.5459E+01,1.3211E+01,1.1204E+01,9.7024E+00/ | |
37772 | DATA (XGF_L(K),K= 1597, 1710) / | |
37773 | &8.2828E+00,6.8644E+00,5.6367E+00,4.6059E+00,3.7241E+00,3.0915E+00, | |
37774 | &2.5189E+00,1.9786E+00,1.5396E+00,1.2816E+00,1.0611E+00,9.1306E-01, | |
37775 | &7.8207E-01,6.8594E-01,6.1118E-01,5.5075E-01,5.0031E-01,4.5732E-01, | |
37776 | &4.1996E-01,3.8671E-01,3.5732E-01,3.3101E-01,3.0775E-01,2.8769E-01, | |
37777 | &2.4931E-01,2.1637E-01,1.8763E-01,1.6241E-01,1.4002E-01,1.2013E-01, | |
37778 | &1.0238E-01,8.6311E-02,7.1348E-02,5.2982E-02,0.0000E+00,0.0000E+00, | |
37779 | &4.2142E+02,3.8237E+02,3.4660E+02,3.1292E+02,2.8259E+02,2.5300E+02, | |
37780 | &2.2626E+02,2.0148E+02,1.7927E+02,1.5797E+02,1.3896E+02,1.2163E+02, | |
37781 | &1.0632E+02,9.7858E+01,8.9366E+01,8.0488E+01,7.2234E+01,6.4771E+01, | |
37782 | &5.7843E+01,5.2468E+01,4.7182E+01,4.1663E+01,3.6633E+01,3.2165E+01, | |
37783 | &2.8082E+01,2.4971E+01,2.1960E+01,1.8866E+01,1.6118E+01,1.3723E+01, | |
37784 | &1.1595E+01,1.0008E+01,8.5101E+00,7.0232E+00,5.7443E+00,4.6705E+00, | |
37785 | &3.7584E+00,3.1066E+00,2.5189E+00,1.9659E+00,1.5193E+00,1.2575E+00, | |
37786 | &1.0346E+00,8.8517E-01,7.5338E-01,6.5695E-01,5.8219E-01,5.2200E-01, | |
37787 | &4.7218E-01,4.2954E-01,3.9258E-01,3.6043E-01,3.3190E-01,3.0663E-01, | |
37788 | &2.8431E-01,2.6413E-01,2.2746E-01,1.9612E-01,1.6912E-01,1.4557E-01, | |
37789 | &1.2488E-01,1.0660E-01,9.0362E-02,7.5731E-02,6.1890E-02,4.2720E-02, | |
37790 | &0.0000E+00,0.0000E+00,4.7166E+02,4.2676E+02,3.8580E+02,3.4749E+02, | |
37791 | &3.1273E+02,2.7927E+02,2.4899E+02,2.2108E+02,1.9611E+02,1.7230E+02/ | |
37792 | DATA (XGF_L(K),K= 1711, 1824) / | |
37793 | &1.5107E+02,1.3178E+02,1.1483E+02,1.0548E+02,9.6179E+01,8.6383E+01, | |
37794 | &7.7331E+01,6.9156E+01,6.1613E+01,5.5763E+01,5.0019E+01,4.4056E+01, | |
37795 | &3.8633E+01,3.3819E+01,2.9446E+01,2.6108E+01,2.2889E+01,1.9617E+01, | |
37796 | &1.6706E+01,1.4179E+01,1.1938E+01,1.0276E+01,8.7112E+00,7.1630E+00, | |
37797 | &5.8345E+00,4.7275E+00,3.7856E+00,3.1171E+00,2.5164E+00,1.9532E+00, | |
37798 | &1.4997E+00,1.2350E+00,1.0108E+00,8.6027E-01,7.2804E-01,6.3166E-01, | |
37799 | &5.5726E-01,4.9745E-01,4.4802E-01,4.0623E-01,3.7002E-01,3.3850E-01, | |
37800 | &3.1081E-01,2.8644E-01,2.6509E-01,2.4476E-01,2.0951E-01,1.7979E-01, | |
37801 | &1.5426E-01,1.3217E-01,1.1290E-01,9.5951E-02,8.0975E-02,6.7483E-02, | |
37802 | &5.4483E-02,3.4309E-02,0.0000E+00,0.0000E+00,5.2745E+02,4.7595E+02, | |
37803 | &4.2900E+02,3.8543E+02,3.4589E+02,3.0795E+02,2.7377E+02,2.4235E+02, | |
37804 | &2.1434E+02,1.8771E+02,1.6408E+02,1.4266E+02,1.2392E+02,1.1358E+02, | |
37805 | &1.0335E+02,9.2593E+01,8.2702E+01,7.3780E+01,6.5553E+01,5.9207E+01, | |
37806 | &5.2983E+01,4.6535E+01,4.0700E+01,3.5531E+01,3.0842E+01,2.7278E+01, | |
37807 | &2.3855E+01,2.0386E+01,1.7301E+01,1.4635E+01,1.2282E+01,1.0538E+01, | |
37808 | &8.9065E+00,7.2932E+00,5.9178E+00,4.7769E+00,3.8086E+00,3.1240E+00, | |
37809 | &2.5114E+00,1.9387E+00,1.4794E+00,1.2125E+00,9.8604E-01,8.3538E-01, | |
37810 | &7.0309E-01,6.0683E-01,5.3289E-01,4.7378E-01,4.2493E-01,3.8387E-01, | |
37811 | &3.4846E-01,3.1778E-01,2.9097E-01,2.6744E-01,2.4699E-01,2.2688E-01/ | |
37812 | DATA (XGF_L(K),K= 1825, 1836) / | |
37813 | &1.9308E-01,1.6489E-01,1.4079E-01,1.2009E-01,1.0214E-01,8.6447E-02, | |
37814 | &7.2603E-02,6.0131E-02,4.7893E-02,2.6613E-02,0.0000E+00,0.0000E+00/ | |
37815 | ||
37816 | * | |
37817 | X = Xinp | |
37818 | *...CHECK OF X AND Q2 VALUES : | |
37819 | IF ( (X.LT.0.99D-9) .OR. (X.GT.1.D0) ) THEN | |
37820 | * WRITE(LO,91) X | |
37821 | 91 FORMAT (2X,'GRV98: x out of range',1p,E12.4) | |
37822 | X = 0.99D-9 | |
37823 | * STOP | |
37824 | ENDIF | |
37825 | ||
37826 | Q2 = Q2inp | |
37827 | IF ( (Q2.LT.0.799) .OR. (Q2.GT.1.E6) ) THEN | |
37828 | * WRITE(LO,92) Q2 | |
37829 | 92 FORMAT (2X,'GRV98: Q2 out of range',1p,E12.4) | |
37830 | Q2 = 0.99E6 | |
37831 | * STOP | |
37832 | ENDIF | |
37833 | ||
37834 | * | |
37835 | *...INTERPOLATION : | |
37836 | NA(1) = NX | |
37837 | NA(2) = NQ | |
37838 | XT(1) = DLOG(X) | |
37839 | XT(2) = DLOG(Q2) | |
37840 | X1 = 1.- X | |
37841 | XV = X**0.5 | |
37842 | XS = X**(-0.2) | |
37843 | UV = PHO_DBFINT(NARG,XT,NA,ARRF,XUVF) * X1**3 * XV | |
37844 | DV = PHO_DBFINT(NARG,XT,NA,ARRF,XDVF) * X1**4 * XV | |
37845 | DE = PHO_DBFINT(NARG,XT,NA,ARRF,XDEF) * X1**7 * XV | |
37846 | UD = PHO_DBFINT(NARG,XT,NA,ARRF,XUDF) * X1**7 * XS | |
37847 | US = 0.5 * (UD - DE) | |
37848 | DS = 0.5 * (UD + DE) | |
37849 | SS = PHO_DBFINT(NARG,XT,NA,ARRF,XSF) * X1**7 * XS | |
37850 | GL = PHO_DBFINT(NARG,XT,NA,ARRF,XGF) * X1**5 * XS | |
37851 | ||
37852 | END | |
37853 | ||
37854 | *$ CREATE PHO_DOR98SC.FOR | |
37855 | *COPY PHO_DOR98SC | |
37856 | CDECK ID>, PHO_DOR98SC | |
37857 | SUBROUTINE PHO_DOR98SC (Xinp, Q2inp, UV, DV, US, DS, SS, GL) | |
37858 | C*********************************************************************** | |
37859 | C | |
37860 | C GRV98 parton densities, leading order set | |
37861 | C | |
37862 | C For a detailed explanation see | |
37863 | C M. Glueck, E. Reya, A. Vogt : | |
37864 | C hep-ph/9806404 = DO-TH 98/07 = WUE-ITP-98-019 | |
37865 | C (To appear in Eur. Phys. J. C) | |
37866 | C | |
37867 | C interpolation routine based on the original GRV98PA routine, | |
37868 | C adapted to define interpolation table as DATA statements | |
37869 | C | |
37870 | C (R.Engel, 09/98) | |
37871 | C | |
37872 | C CAUTION: this is a version with gluon shadowing corrections | |
37873 | C (R.Engel, 09/99) | |
37874 | C | |
37875 | C | |
37876 | C INPUT: X = Bjorken-x (between 1.E-9 and 1.) | |
37877 | C Q2 = scale in GeV**2 (between 0.8 and 1.E6) | |
37878 | C | |
37879 | C OUTPUT: UV = u - u(bar), DV = d - d(bar), US = u(bar), | |
37880 | C DS = d(bar), SS = s = s(bar), GL = gluon. | |
37881 | C Always x times the distribution is returned. | |
37882 | C | |
37883 | C******************************************************i**************** | |
37884 | IMPLICIT DOUBLE PRECISION (A-H, O-Z) | |
37885 | SAVE | |
37886 | ||
37887 | C input/output channels | |
37888 | INTEGER LI,LO | |
37889 | COMMON /POINOU/ LI,LO | |
37890 | ||
37891 | PARAMETER (NPART=6, NX=68, NQ=27, NARG=2) | |
37892 | DIMENSION XUVF(NX,NQ), XDVF(NX,NQ), XDEF(NX,NQ), XUDF(NX,NQ), | |
37893 | 1 XSF(NX,NQ), XGF(NX,NQ), | |
37894 | 2 XT(NARG), NA(NARG), ARRF(NX+NQ) | |
37895 | ||
37896 | DIMENSION XUVF_L(NX*NQ), XDVF_L(NX*NQ), XDEF_L(NX*NQ), | |
37897 | & XUDF_L(NX*NQ), XSF_L(NX*NQ), XGF_L(NX*NQ) | |
37898 | ||
37899 | EQUIVALENCE (XUVF(1,1),XUVF_L(1)) | |
37900 | EQUIVALENCE (XDVF(1,1),XDVF_L(1)) | |
37901 | EQUIVALENCE (XDEF(1,1),XDEF_L(1)) | |
37902 | EQUIVALENCE (XUDF(1,1),XUDF_L(1)) | |
37903 | EQUIVALENCE (XSF(1,1),XSF_L(1)) | |
37904 | EQUIVALENCE (XGF(1,1),XGF_L(1)) | |
37905 | ||
37906 | *#################### data statements for shadowed LO PDF ############## | |
37907 | C ... deleted ... | |
37908 | *####################################################################### | |
37909 | ||
37910 | X = Xinp | |
37911 | *...CHECK OF X AND Q2 VALUES : | |
37912 | IF ( (X.LT.0.99D-9) .OR. (X.GT.1.D0) ) THEN | |
37913 | * WRITE(LO,91) X | |
37914 | 91 FORMAT (2X,'GRV98_SC: x out of range',1p,E12.4) | |
37915 | X = 0.99D-9 | |
37916 | * STOP | |
37917 | ENDIF | |
37918 | ||
37919 | Q2 = Q2inp | |
37920 | IF ( (Q2.LT.0.799) .OR. (Q2.GT.1.E6) ) THEN | |
37921 | * WRITE(LO,92) Q2 | |
37922 | 92 FORMAT (2X,'GRV98_SC: Q2 out of range',1p,E12.4) | |
37923 | Q2 = 0.99E6 | |
37924 | * STOP | |
37925 | ENDIF | |
37926 | ||
37927 | * | |
37928 | *...INTERPOLATION : | |
37929 | NA(1) = NX | |
37930 | NA(2) = NQ | |
37931 | XT(1) = DLOG(X) | |
37932 | XT(2) = DLOG(Q2) | |
37933 | X1 = 1.- X | |
37934 | XV = X**0.5 | |
37935 | XS = X**(-0.2) | |
37936 | UV = PHO_DBFINT(NARG,XT,NA,ARRF,XUVF) * X1**3 * XV | |
37937 | DV = PHO_DBFINT(NARG,XT,NA,ARRF,XDVF) * X1**4 * XV | |
37938 | DE = PHO_DBFINT(NARG,XT,NA,ARRF,XDEF) * X1**7 * XV | |
37939 | UD = PHO_DBFINT(NARG,XT,NA,ARRF,XUDF) * X1**7 * XS | |
37940 | US = 0.5 * (UD - DE) | |
37941 | DS = 0.5 * (UD + DE) | |
37942 | SS = PHO_DBFINT(NARG,XT,NA,ARRF,XSF) * X1**7 * XS | |
37943 | GL = PHO_DBFINT(NARG,XT,NA,ARRF,XGF) * X1**5 * XS | |
37944 | ||
37945 | END | |
37946 | ||
37947 | *$ CREATE PHO_DOR94LO.FOR | |
37948 | *COPY PHO_DOR94LO | |
37949 | CDECK ID>, PHO_DOR94LO | |
37950 | * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * | |
37951 | * * | |
37952 | * G R V - P R O T O N - P A R A M E T R I Z A T I O N S * | |
37953 | * * | |
37954 | * 1994 UPDATE * | |
37955 | * * | |
37956 | * FOR A DETAILED EXPLANATION SEE * | |
37957 | * M. GLUECK, E.REYA, A.VOGT : * | |
37958 | * DO-TH 94/24 = DESY 94-206 * | |
37959 | * (TO APPEAR IN Z. PHYS. C) * | |
37960 | * * | |
37961 | * THE PARAMETRIZATIONS ARE FITTED TO THE EVOLVED PARTONS FOR * | |
37962 | * Q**2 / GEV**2 BETWEEN 0.4 AND 1.E6 * | |
37963 | * X BETWEEN 1.E-5 AND 1. * | |
37964 | * LARGE-X REGIONS, WHERE THE DISTRIBUTION UNDER CONSIDERATION * | |
37965 | * IS NEGLIGIBLY SMALL, WERE EXCLUDED FROM THE FIT. * | |
37966 | * * | |
37967 | * HEAVY QUARK THRESHOLDS Q(H) = M(H) IN THE BETA FUNCTION : * | |
37968 | * M(C) = 1.5, M(B) = 4.5 * | |
37969 | * CORRESPONDING LAMBDA(F) VALUES IN GEV FOR Q**2 > M(H)**2 : * | |
37970 | * LO : LAMBDA(3) = 0.232, LAMBDA(4) = 0.200, * | |
37971 | * LAMBDA(5) = 0.153, * | |
37972 | * NLO : LAMBDA(3) = 0.248, LAMBDA(4) = 0.200, * | |
37973 | * LAMBDA(5) = 0.131. * | |
37974 | * THE NUMBER OF ACTIVE QUARK FLAVOURS IS NF = 3 EVERYWHERE * | |
37975 | * EXCEPT IN THE BETA FUNCTION, I.E. THE HEAVY QUARKS C,B,... * | |
37976 | * ARE NOT PRESENT AS PARTONS IN THE Q2-EVOLUTION. * | |
37977 | * IF NEEDED, HEAVY QUARK DENSITIES CAN BE TAKEN FROM THE 1991 * | |
37978 | * GRV PARAMETRIZATION. * | |
37979 | * * | |
37980 | * NLO DISTRIBUTIONS ARE GIVEN IN MS-BAR FACTORIZATION SCHEME * | |
37981 | * (SUBROUTINE GRV94HO) AS WELL AS IN THE DIS SCHEME (GRV94DI), * | |
37982 | * THE LEADING ORDER PARAMETRIZATION IS PROVIDED BY "GRV94LO". * | |
37983 | * * | |
37984 | * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * | |
37985 | * | |
37986 | *...INPUT PARAMETERS : | |
37987 | * | |
37988 | * X = MOMENTUM FRACTION | |
37989 | * Q2 = SCALE Q**2 IN GEV**2 | |
37990 | * | |
37991 | *...OUTPUT (ALWAYS X TIMES THE DISTRIBUTION) : | |
37992 | * | |
37993 | * UV = U(VAL) = U - U(BAR) | |
37994 | * DV = D(VAL) = D - D(BAR) | |
37995 | * DEL = D(BAR) - U(BAR) | |
37996 | * UDB = U(BAR) + D(BAR) | |
37997 | * SB = S = S(BAR) | |
37998 | * GL = GLUON | |
37999 | * | |
38000 | *...LO PARAMETRIZATION : | |
38001 | * | |
38002 | SUBROUTINE PHO_DOR94LO (X, Q2, UV, DV, DEL, UDB, SB, GL) | |
38003 | IMPLICIT DOUBLE PRECISION (A - Z) | |
38004 | SAVE | |
38005 | ||
38006 | MU2 = 0.23 | |
38007 | LAM2 = 0.2322 * 0.2322 | |
38008 | S = LOG (LOG(Q2/LAM2) / LOG(MU2/LAM2)) | |
38009 | DS = SQRT (S) | |
38010 | S2 = S * S | |
38011 | S3 = S2 * S | |
38012 | *...UV : | |
38013 | NU = 2.284 + 0.802 * S + 0.055 * S2 | |
38014 | AKU = 0.590 - 0.024 * S | |
38015 | BKU = 0.131 + 0.063 * S | |
38016 | AU = -0.449 - 0.138 * S - 0.076 * S2 | |
38017 | BU = 0.213 + 2.669 * S - 0.728 * S2 | |
38018 | CU = 8.854 - 9.135 * S + 1.979 * S2 | |
38019 | DU = 2.997 + 0.753 * S - 0.076 * S2 | |
38020 | UV = PHO_DOR94FV (X, NU, AKU, BKU, AU, BU, CU, DU) | |
38021 | *...DV : | |
38022 | ND = 0.371 + 0.083 * S + 0.039 * S2 | |
38023 | AKD = 0.376 | |
38024 | BKD = 0.486 + 0.062 * S | |
38025 | AD = -0.509 + 3.310 * S - 1.248 * S2 | |
38026 | BD = 12.41 - 10.52 * S + 2.267 * S2 | |
38027 | CD = 6.373 - 6.208 * S + 1.418 * S2 | |
38028 | DD = 3.691 + 0.799 * S - 0.071 * S2 | |
38029 | DV = PHO_DOR94FV (X, ND, AKD, BKD, AD, BD, CD, DD) | |
38030 | *...DEL : | |
38031 | NE = 0.082 + 0.014 * S + 0.008 * S2 | |
38032 | AKE = 0.409 - 0.005 * S | |
38033 | BKE = 0.799 + 0.071 * S | |
38034 | AE = -38.07 + 36.13 * S - 0.656 * S2 | |
38035 | BE = 90.31 - 74.15 * S + 7.645 * S2 | |
38036 | CE = 0.0 | |
38037 | DE = 7.486 + 1.217 * S - 0.159 * S2 | |
38038 | DEL = PHO_DOR94FV (X, NE, AKE, BKE, AE, BE, CE, DE) | |
38039 | *...UDB : | |
38040 | ALX = 1.451 | |
38041 | BEX = 0.271 | |
38042 | AKX = 0.410 - 0.232 * S | |
38043 | BKX = 0.534 - 0.457 * S | |
38044 | AGX = 0.890 - 0.140 * S | |
38045 | BGX = -0.981 | |
38046 | CX = 0.320 + 0.683 * S | |
38047 | DX = 4.752 + 1.164 * S + 0.286 * S2 | |
38048 | EX = 4.119 + 1.713 * S | |
38049 | ESX = 0.682 + 2.978 * S | |
38050 | UDB = PHO_DOR94FW(X,S,ALX,BEX,AKX,BKX,AGX,BGX,CX,DX,EX,ESX) | |
38051 | *...SB : | |
38052 | ALS = 0.914 | |
38053 | BES = 0.577 | |
38054 | AKS = 1.798 - 0.596 * S | |
38055 | AS = -5.548 + 3.669 * DS - 0.616 * S | |
38056 | BS = 18.92 - 16.73 * DS + 5.168 * S | |
38057 | DST = 6.379 - 0.350 * S + 0.142 * S2 | |
38058 | EST = 3.981 + 1.638 * S | |
38059 | ESS = 6.402 | |
38060 | SB = PHO_DOR94FS (X, S, ALS, BES, AKS, AS, BS, DST, EST, ESS) | |
38061 | *...GL : | |
38062 | ALG = 0.524 | |
38063 | BEG = 1.088 | |
38064 | AKG = 1.742 - 0.930 * S | |
38065 | BKG = - 0.399 * S2 | |
38066 | AG = 7.486 - 2.185 * S | |
38067 | BG = 16.69 - 22.74 * S + 5.779 * S2 | |
38068 | CG = -25.59 + 29.71 * S - 7.296 * S2 | |
38069 | DG = 2.792 + 2.215 * S + 0.422 * S2 - 0.104 * S3 | |
38070 | EG = 0.807 + 2.005 * S | |
38071 | ESG = 3.841 + 0.316 * S | |
38072 | GL = PHO_DOR94FW(X,S,ALG,BEG,AKG,BKG,AG,BG,CG,DG,EG,ESG) | |
38073 | ||
38074 | END | |
38075 | ||
38076 | * | |
38077 | *...NLO PARAMETRIZATION (MS(BAR)) : | |
38078 | * | |
38079 | *$ CREATE PHO_DOR94HO.FOR | |
38080 | *COPY PHO_DOR94HO | |
38081 | CDECK ID>, PHO_DOR94HO | |
38082 | SUBROUTINE PHO_DOR94HO (X, Q2, UV, DV, DEL, UDB, SB, GL) | |
38083 | IMPLICIT DOUBLE PRECISION (A - Z) | |
38084 | SAVE | |
38085 | ||
38086 | MU2 = 0.34 | |
38087 | LAM2 = 0.248 * 0.248 | |
38088 | S = LOG (LOG(Q2/LAM2) / LOG(MU2/LAM2)) | |
38089 | DS = SQRT (S) | |
38090 | S2 = S * S | |
38091 | S3 = S2 * S | |
38092 | *...UV : | |
38093 | NU = 1.304 + 0.863 * S | |
38094 | AKU = 0.558 - 0.020 * S | |
38095 | BKU = 0.183 * S | |
38096 | AU = -0.113 + 0.283 * S - 0.321 * S2 | |
38097 | BU = 6.843 - 5.089 * S + 2.647 * S2 - 0.527 * S3 | |
38098 | CU = 7.771 - 10.09 * S + 2.630 * S2 | |
38099 | DU = 3.315 + 1.145 * S - 0.583 * S2 + 0.154 * S3 | |
38100 | UV = PHO_DOR94FV (X, NU, AKU, BKU, AU, BU, CU, DU) | |
38101 | *...DV : | |
38102 | ND = 0.102 - 0.017 * S + 0.005 * S2 | |
38103 | AKD = 0.270 - 0.019 * S | |
38104 | BKD = 0.260 | |
38105 | AD = 2.393 + 6.228 * S - 0.881 * S2 | |
38106 | BD = 46.06 + 4.673 * S - 14.98 * S2 + 1.331 * S3 | |
38107 | CD = 17.83 - 53.47 * S + 21.24 * S2 | |
38108 | DD = 4.081 + 0.976 * S - 0.485 * S2 + 0.152 * S3 | |
38109 | DV = PHO_DOR94FV (X, ND, AKD, BKD, AD, BD, CD, DD) | |
38110 | *...DEL : | |
38111 | NE = 0.070 + 0.042 * S - 0.011 * S2 + 0.004 * S3 | |
38112 | AKE = 0.409 - 0.007 * S | |
38113 | BKE = 0.782 + 0.082 * S | |
38114 | AE = -29.65 + 26.49 * S + 5.429 * S2 | |
38115 | BE = 90.20 - 74.97 * S + 4.526 * S2 | |
38116 | CE = 0.0 | |
38117 | DE = 8.122 + 2.120 * S - 1.088 * S2 + 0.231 * S3 | |
38118 | DEL = PHO_DOR94FV (X, NE, AKE, BKE, AE, BE, CE, DE) | |
38119 | *...UDB : | |
38120 | ALX = 0.877 | |
38121 | BEX = 0.561 | |
38122 | AKX = 0.275 | |
38123 | BKX = 0.0 | |
38124 | AGX = 0.997 | |
38125 | BGX = 3.210 - 1.866 * S | |
38126 | CX = 7.300 | |
38127 | DX = 9.010 + 0.896 * DS + 0.222 * S2 | |
38128 | EX = 3.077 + 1.446 * S | |
38129 | ESX = 3.173 - 2.445 * DS + 2.207 * S | |
38130 | UDB = PHO_DOR94FW(X,S,ALX,BEX,AKX,BKX,AGX,BGX,CX,DX,EX,ESX) | |
38131 | *...SB : | |
38132 | ALS = 0.756 | |
38133 | BES = 0.216 | |
38134 | AKS = 1.690 + 0.650 * DS - 0.922 * S | |
38135 | AS = -4.329 + 1.131 * S | |
38136 | BS = 9.568 - 1.744 * S | |
38137 | DST = 9.377 + 1.088 * DS - 1.320 * S + 0.130 * S2 | |
38138 | EST = 3.031 + 1.639 * S | |
38139 | ESS = 5.837 + 0.815 * S | |
38140 | SB = PHO_DOR94FS (X, S, ALS, BES, AKS, AS, BS, DST, EST, ESS) | |
38141 | *...GL : | |
38142 | ALG = 1.014 | |
38143 | BEG = 1.738 | |
38144 | AKG = 1.724 + 0.157 * S | |
38145 | BKG = 0.800 + 1.016 * S | |
38146 | AG = 7.517 - 2.547 * S | |
38147 | BG = 34.09 - 52.21 * DS + 17.47 * S | |
38148 | CG = 4.039 + 1.491 * S | |
38149 | DG = 3.404 + 0.830 * S | |
38150 | EG = -1.112 + 3.438 * S - 0.302 * S2 | |
38151 | ESG = 3.256 - 0.436 * S | |
38152 | GL = PHO_DOR94FW(X,S,ALG,BEG,AKG,BKG,AG,BG,CG,DG,EG,ESG) | |
38153 | ||
38154 | END | |
38155 | ||
38156 | *$ CREATE PHO_DOR94DI.FOR | |
38157 | *COPY PHO_DOR94DI | |
38158 | CDECK ID>, PHO_DOR94DI | |
38159 | * | |
38160 | *...NLO PARAMETRIZATION (DIS) : | |
38161 | * | |
38162 | SUBROUTINE PHO_DOR94DI (X, Q2, UV, DV, DEL, UDB, SB, GL) | |
38163 | IMPLICIT DOUBLE PRECISION (A - Z) | |
38164 | SAVE | |
38165 | ||
38166 | MU2 = 0.34 | |
38167 | LAM2 = 0.248 * 0.248 | |
38168 | S = LOG (LOG(Q2/LAM2) / LOG(MU2/LAM2)) | |
38169 | DS = SQRT (S) | |
38170 | S2 = S * S | |
38171 | S3 = S2 * S | |
38172 | *...UV : | |
38173 | NU = 2.484 + 0.116 * S + 0.093 * S2 | |
38174 | AKU = 0.563 - 0.025 * S | |
38175 | BKU = 0.054 + 0.154 * S | |
38176 | AU = -0.326 - 0.058 * S - 0.135 * S2 | |
38177 | BU = -3.322 + 8.259 * S - 3.119 * S2 + 0.291 * S3 | |
38178 | CU = 11.52 - 12.99 * S + 3.161 * S2 | |
38179 | DU = 2.808 + 1.400 * S - 0.557 * S2 + 0.119 * S3 | |
38180 | UV = PHO_DOR94FV (X, NU, AKU, BKU, AU, BU, CU, DU) | |
38181 | *...DV : | |
38182 | ND = 0.156 - 0.017 * S | |
38183 | AKD = 0.299 - 0.022 * S | |
38184 | BKD = 0.259 - 0.015 * S | |
38185 | AD = 3.445 + 1.278 * S + 0.326 * S2 | |
38186 | BD = -6.934 + 37.45 * S - 18.95 * S2 + 1.463 * S3 | |
38187 | CD = 55.45 - 69.92 * S + 20.78 * S2 | |
38188 | DD = 3.577 + 1.441 * S - 0.683 * S2 + 0.179 * S3 | |
38189 | DV = PHO_DOR94FV (X, ND, AKD, BKD, AD, BD, CD, DD) | |
38190 | *...DEL : | |
38191 | NE = 0.099 + 0.019 * S + 0.002 * S2 | |
38192 | AKE = 0.419 - 0.013 * S | |
38193 | BKE = 1.064 - 0.038 * S | |
38194 | AE = -44.00 + 98.70 * S - 14.79 * S2 | |
38195 | BE = 28.59 - 40.94 * S - 13.66 * S2 + 2.523 * S3 | |
38196 | CE = 84.57 - 108.8 * S + 31.52 * S2 | |
38197 | DE = 7.469 + 2.480 * S - 0.866 * S2 | |
38198 | DEL = PHO_DOR94FV (X, NE, AKE, BKE, AE, BE, CE, DE) | |
38199 | *...UDB : | |
38200 | ALX = 1.215 | |
38201 | BEX = 0.466 | |
38202 | AKX = 0.326 + 0.150 * S | |
38203 | BKX = 0.956 + 0.405 * S | |
38204 | AGX = 0.272 | |
38205 | BGX = 3.794 - 2.359 * DS | |
38206 | CX = 2.014 | |
38207 | DX = 7.941 + 0.534 * DS - 0.940 * S + 0.410 * S2 | |
38208 | EX = 3.049 + 1.597 * S | |
38209 | ESX = 4.396 - 4.594 * DS + 3.268 * S | |
38210 | UDB = PHO_DOR94FW(X,S,ALX,BEX,AKX,BKX,AGX,BGX,CX,DX,EX,ESX) | |
38211 | *...SB : | |
38212 | ALS = 0.175 | |
38213 | BES = 0.344 | |
38214 | AKS = 1.415 - 0.641 * DS | |
38215 | AS = 0.580 - 9.763 * DS + 6.795 * S - 0.558 * S2 | |
38216 | BS = 5.617 + 5.709 * DS - 3.972 * S | |
38217 | DST = 13.78 - 9.581 * S + 5.370 * S2 - 0.996 * S3 | |
38218 | EST = 4.546 + 0.372 * S2 | |
38219 | ESS = 5.053 - 1.070 * S + 0.805 * S2 | |
38220 | SB = PHO_DOR94FS (X, S, ALS, BES, AKS, AS, BS, DST, EST, ESS) | |
38221 | *...GL : | |
38222 | ALG = 1.258 | |
38223 | BEG = 1.846 | |
38224 | AKG = 2.423 | |
38225 | BKG = 2.427 + 1.311 * S - 0.153 * S2 | |
38226 | AG = 25.09 - 7.935 * S | |
38227 | BG = -14.84 - 124.3 * DS + 72.18 * S | |
38228 | CG = 590.3 - 173.8 * S | |
38229 | DG = 5.196 + 1.857 * S | |
38230 | EG = -1.648 + 3.988 * S - 0.432 * S2 | |
38231 | ESG = 3.232 - 0.542 * S | |
38232 | GL = PHO_DOR94FW(X,S,ALG,BEG,AKG,BKG,AG,BG,CG,DG,EG,ESG) | |
38233 | ||
38234 | END | |
38235 | ||
38236 | * | |
38237 | *...FUNCTIONAL FORMS OF THE PARAMETRIZATIONS : | |
38238 | * | |
38239 | *$ CREATE PHO_DOR94FV.FOR | |
38240 | *COPY PHO_DOR94FV | |
38241 | CDECK ID>, PHO_DOR94FV | |
38242 | DOUBLE PRECISION FUNCTION PHO_DOR94FV (X,N,AK,BK,A,B,C,D) | |
38243 | IMPLICIT DOUBLE PRECISION (A - Z) | |
38244 | SAVE | |
38245 | ||
38246 | DX = SQRT (X) | |
38247 | PHO_DOR94FV = N*X**AK*(1.D0+A*X**BK+X*(B+C*DX))*(1.D0-X)**D | |
38248 | ||
38249 | END | |
38250 | ||
38251 | *$ CREATE PHO_DOR94FW.FOR | |
38252 | *COPY PHO_DOR94FW | |
38253 | CDECK ID>, PHO_DOR94FW | |
38254 | DOUBLE PRECISION FUNCTION PHO_DOR94FW(X,S,AL,BE,AK,BK, | |
38255 | & A,B,C,D,E,ES) | |
38256 | IMPLICIT DOUBLE PRECISION (A - Z) | |
38257 | SAVE | |
38258 | ||
38259 | LX = LOG (1./X) | |
38260 | PHO_DOR94FW = (X**AK * (A + X * (B + X*C)) * LX**BK + S**AL | |
38261 | 1 * DEXP (-E + SQRT (ES * S**BE * LX))) * (1.- X)**D | |
38262 | ||
38263 | END | |
38264 | ||
38265 | *$ CREATE PHO_DOR94FS.FOR | |
38266 | *COPY PHO_DOR94FS | |
38267 | CDECK ID>, PHO_DOR94FS | |
38268 | DOUBLE PRECISION FUNCTION PHO_DOR94FS (X,S,AL,BE,AK,AG,B,D,E,ES) | |
38269 | IMPLICIT DOUBLE PRECISION (A - Z) | |
38270 | SAVE | |
38271 | ||
38272 | DX = SQRT (X) | |
38273 | LX = LOG (1./X) | |
38274 | PHO_DOR94FS = S**AL / LX**AK * (1.+ AG*DX + B*X) * (1.- X)**D | |
38275 | 1 * DEXP (-E + SQRT (ES * S**BE * LX)) | |
38276 | ||
38277 | END | |
38278 | ||
38279 | *$ CREATE PHO_DOR92LO.FOR | |
38280 | *COPY PHO_DOR92LO | |
38281 | CDECK ID>, PHO_DOR92LO | |
38282 | * | |
38283 | * | |
38284 | * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * | |
38285 | * * | |
38286 | * G R V - P R O T O N - P A R A M E T R I Z A T I O N S * | |
38287 | * * | |
38288 | * FOR A DETAILED EXPLANATION SEE : * | |
38289 | * M. GLUECK, E.REYA, A.VOGT: DO-TH 91/07 * | |
38290 | * * | |
38291 | * THE PARAMETRIZATIONS ARE FITTED TO THE PARTON DISTRIBUTIONS * | |
38292 | * FOR Q ** 2 BETWEEN MU ** 2 (= 0.25 / 0.30 GEV ** 2 IN LO * | |
38293 | * / HO) AND 1.E8 GEV ** 2 AND FOR X BETWEEN 1.E-5 AND 1. * | |
38294 | * REGIONS, WHERE THE DISTRIBUTION UNDER CONSIDERATION IS NEG- * | |
38295 | * LIGIBLE, I.E. BELOW ABOUT 1.E-4, WERE EXCLUDED FROM THE FIT. * | |
38296 | * * | |
38297 | * HEAVY QUARK THRESHOLDS Q(H) = M(H) : * | |
38298 | * M(C) = 1.5, M(B) = 4.5, M(T) = 100 GEV * | |
38299 | * * | |
38300 | * CORRESPONDING LAMBDA(F) VALUES FOR F ACTIVE FLAVOURS : * | |
38301 | * LO : LAMBDA(3) = 0.232, LAMBDA(4) = 0.200, * | |
38302 | * LAMBDA(5) = 0.153, LAMBDA(6) = 0.082 GEV * | |
38303 | * HO : LAMBDA(3) = 0.248, LAMBDA(4) = 0.200, * | |
38304 | * LAMBDA(5) = 0.131, LAMBDA(6) = 0.053 GEV * | |
38305 | * * | |
38306 | * HO DISTRIBUTION REFER TO THE MS-BAR SCHEME OF BARDEEN ET AL. * | |
38307 | * * | |
38308 | * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * | |
38309 | C | |
38310 | SUBROUTINE PHO_DOR92LO (X, Q2, UDV, DV, GL, UDB, SB, CB, BB) | |
38311 | IMPLICIT DOUBLE PRECISION (A - Z) | |
38312 | SAVE | |
38313 | ||
38314 | MU2 = 0.25 | |
38315 | LAM2 = 0.232 * 0.232 | |
38316 | S = LOG (LOG(Q2/LAM2) / LOG(MU2/LAM2)) | |
38317 | S2 = S * S | |
38318 | S3 = S2 * S | |
38319 | C...X * (UV + DV) : | |
38320 | NUD = 0.663 + 0.191 * S - 0.041 * S2 + 0.031 * S3 | |
38321 | AKUD = 0.326 | |
38322 | AGUD = -1.97 + 6.74 * S - 1.96 * S2 | |
38323 | BUD = 24.4 - 20.7 * S + 4.08 * S2 | |
38324 | DUD = 2.86 + 0.70 * S - 0.02 * S2 | |
38325 | UDV = PHO_DOR92FV (X, NUD, AKUD, AGUD, BUD, DUD) | |
38326 | C...X * DV : | |
38327 | ND = 0.579 + 0.283 * S + 0.047 * S2 | |
38328 | AKD = 0.523 - 0.015 * S | |
38329 | AGD = 2.22 - 0.59 * S - 0.27 * S2 | |
38330 | BD = 5.95 - 6.19 * S + 1.55 * S2 | |
38331 | DD = 3.57 + 0.94 * S - 0.16 * S2 | |
38332 | DV = PHO_DOR92FV (X,ND,AKD,AGD,BD,DD) | |
38333 | C...X * G : | |
38334 | ALG = 0.558 | |
38335 | BEG = 1.218 | |
38336 | AKG = 1.00 - 0.17 * S | |
38337 | BKG = 0.0 | |
38338 | AGG = 0.0 + 4.879 * S - 1.383 * S2 | |
38339 | BGG = 25.92 - 28.97 * S + 5.596 * S2 | |
38340 | CG = -25.69 + 23.68 * S - 1.975 * S2 | |
38341 | DG = 2.537 + 1.718 * S + 0.353 * S2 | |
38342 | EG = 0.595 + 2.138 * S | |
38343 | ESG = 4.066 | |
38344 | GL = PHO_DOR92FW(X,S,ALG,BEG,AKG,BKG,AGG,BGG,CG,DG,EG,ESG) | |
38345 | C...X * UBAR = X * DBAR : | |
38346 | ALU = 1.396 | |
38347 | BEU = 1.331 | |
38348 | AKU = 0.412 - 0.171 * S | |
38349 | BKU = 0.566 - 0.496 * S | |
38350 | AGU = 0.363 | |
38351 | BGU = -1.196 | |
38352 | CU = 1.029 + 1.785 * S - 0.459 * S2 | |
38353 | DU = 4.696 + 2.109 * S | |
38354 | EU = 3.838 + 1.944 * S | |
38355 | ESU = 2.845 | |
38356 | UDB = PHO_DOR92FW(X,S,ALU,BEU,AKU,BKU,AGU,BGU,CU,DU,EU,ESU) | |
38357 | C...X * SBAR = X * S : | |
38358 | SS = 0.0 | |
38359 | ALS = 0.803 | |
38360 | BES = 0.563 | |
38361 | AKS = 2.082 - 0.577 * S | |
38362 | AGS = -3.055 + 1.024 * S ** 0.67 | |
38363 | BS = 27.4 - 20.0 * S ** 0.154 | |
38364 | DS = 6.22 | |
38365 | EST = 4.33 + 1.408 * S | |
38366 | ESS = 8.27 - 0.437 * S | |
38367 | SB = PHO_DOR92FS(X,S,SS,ALS,BES,AKS,AGS,BS,DS,EST,ESS) | |
38368 | C...X * CBAR = X * C : | |
38369 | SC = 0.888 | |
38370 | ALC = 1.01 | |
38371 | BEC = 0.37 | |
38372 | AKC = 0.0 | |
38373 | AGC = 0.0 | |
38374 | BC = 4.24 - 0.804 * S | |
38375 | DC = 3.46 + 1.076 * S | |
38376 | EC = 4.61 + 1.490 * S | |
38377 | ESC = 2.555 + 1.961 * S | |
38378 | CB = PHO_DOR92FS(X,S,SC,ALC,BEC,AKC,AGC,BC,DC,EC,ESC) | |
38379 | C...X * BBAR = X * B : | |
38380 | SBO = 1.351 | |
38381 | ALB = 1.00 | |
38382 | BEB = 0.51 | |
38383 | AKB = 0.0 | |
38384 | AGB = 0.0 | |
38385 | BBO = 1.848 | |
38386 | DB = 2.929 + 1.396 * S | |
38387 | EB = 4.71 + 1.514 * S | |
38388 | ESB = 4.02 + 1.239 * S | |
38389 | BB = PHO_DOR92FS(X,S,SBO,ALB,BEB,AKB,AGB,BBO,DB,EB,ESB) | |
38390 | ||
38391 | END | |
38392 | ||
38393 | *$ CREATE PHO_DOR92HO.FOR | |
38394 | *COPY PHO_DOR92HO | |
38395 | CDECK ID>, PHO_DOR92HO | |
38396 | SUBROUTINE PHO_DOR92HO (X, Q2, UDV, DV, GL, UDB, SB, CB, BB) | |
38397 | IMPLICIT DOUBLE PRECISION (A - Z) | |
38398 | SAVE | |
38399 | ||
38400 | MU2 = 0.3 | |
38401 | LAM2 = 0.248 * 0.248 | |
38402 | S = LOG (LOG(Q2/LAM2) / LOG(MU2/LAM2)) | |
38403 | DS = SQRT (S) | |
38404 | S2 = S * S | |
38405 | S3 = S2 * S | |
38406 | C...X * (UV + DV) : | |
38407 | NUD = 0.330 + 0.151 * S - 0.059 * S2 + 0.027 * S3 | |
38408 | AKUD = 0.285 | |
38409 | AGUD = -2.28 + 15.73 * S - 4.58 * S2 | |
38410 | BUD = 56.7 - 53.6 * S + 11.21 * S2 | |
38411 | DUD = 3.17 + 1.17 * S - 0.47 * S2 + 0.09 * S3 | |
38412 | UDV = PHO_DOR92FV (X, NUD, AKUD, AGUD, BUD, DUD) | |
38413 | C...X * DV : | |
38414 | ND = 0.459 + 0.315 * DS + 0.515 * S | |
38415 | AKD = 0.624 - 0.031 * S | |
38416 | AGD = 8.13 - 6.77 * DS + 0.46 * S | |
38417 | BD = 6.59 - 12.83 * DS + 5.65 * S | |
38418 | DD = 3.98 + 1.04 * S - 0.34 * S2 | |
38419 | DV = PHO_DOR92FV (X, ND, AKD, AGD, BD, DD) | |
38420 | C...X * G : | |
38421 | ALG = 1.128 | |
38422 | BEG = 1.575 | |
38423 | AKG = 0.323 + 1.653 * S | |
38424 | BKG = 0.811 + 2.044 * S | |
38425 | AGG = 0.0 + 1.963 * S - 0.519 * S2 | |
38426 | BGG = 0.078 + 6.24 * S | |
38427 | CG = 30.77 - 24.19 * S | |
38428 | DG = 3.188 + 0.720 * S | |
38429 | EG = -0.881 + 2.687 * S | |
38430 | ESG = 2.466 | |
38431 | GL = PHO_DOR92FW(X,S,ALG,BEG,AKG,BKG,AGG,BGG,CG,DG,EG,ESG) | |
38432 | C...X * UBAR = X * DBAR : | |
38433 | ALU = 0.594 | |
38434 | BEU = 0.614 | |
38435 | AKU = 0.636 - 0.084 * S | |
38436 | BKU = 0.0 | |
38437 | AGU = 1.121 - 0.193 * S | |
38438 | BGU = 0.751 - 0.785 * S | |
38439 | CU = 8.57 - 1.763 * S | |
38440 | DU = 10.22 + 0.668 * S | |
38441 | EU = 3.784 + 1.280 * S | |
38442 | ESU = 1.808 + 0.980 * S | |
38443 | UDB = PHO_DOR92FW(X,S,ALU,BEU,AKU,BKU,AGU,BGU,CU,DU,EU,ESU) | |
38444 | C...X * SBAR = X * S : | |
38445 | SS = 0.0 | |
38446 | ALS = 0.756 | |
38447 | BES = 0.101 | |
38448 | AKS = 2.942 - 1.016 * S | |
38449 | AGS = -4.60 + 1.167 * S | |
38450 | BS = 9.31 - 1.324 * S | |
38451 | DS = 11.49 - 1.198 * S + 0.053 * S2 | |
38452 | EST = 2.630 + 1.729 * S | |
38453 | ESS = 8.12 | |
38454 | SB = PHO_DOR92FS (X,S,SS,ALS,BES,AKS,AGS,BS,DS,EST,ESS) | |
38455 | C...X * CBAR = X * C : | |
38456 | SC = 0.820 | |
38457 | ALC = 0.98 | |
38458 | BEC = 0.0 | |
38459 | AKC = -0.625 - 0.523 * S | |
38460 | AGC = 0.0 | |
38461 | BC = 1.896 + 1.616 * S | |
38462 | DC = 4.12 + 0.683 * S | |
38463 | EC = 4.36 + 1.328 * S | |
38464 | ESC = 0.677 + 0.679 * S | |
38465 | CB = PHO_DOR92FS (X,S,SC,ALC,BEC,AKC,AGC,BC,DC,EC,ESC) | |
38466 | C...X * BBAR = X * B : | |
38467 | SBO = 1.297 | |
38468 | ALB = 0.99 | |
38469 | BEB = 0.0 | |
38470 | AKB = 0.0 - 0.193 * S | |
38471 | AGB = 0.0 | |
38472 | BBO = 0.0 | |
38473 | DB = 3.447 + 0.927 * S | |
38474 | EB = 4.68 + 1.259 * S | |
38475 | ESB = 1.892 + 2.199 * S | |
38476 | BB = PHO_DOR92FS(X,S,SBO,ALB,BEB,AKB,AGB,BBO,DB,EB,ESB) | |
38477 | ||
38478 | END | |
38479 | ||
38480 | *$ CREATE PHO_DOR92FV.FOR | |
38481 | *COPY PHO_DOR92FV | |
38482 | CDECK ID>, PHO_DOR92FV | |
38483 | DOUBLE PRECISION FUNCTION PHO_DOR92FV(X,N,AK,AG,B,D) | |
38484 | IMPLICIT DOUBLE PRECISION (A - Z) | |
38485 | SAVE | |
38486 | DX = SQRT (X) | |
38487 | PHO_DOR92FV = N * X**AK * (1.+ AG*DX + B*X) * (1.- X)**D | |
38488 | ||
38489 | END | |
38490 | ||
38491 | *$ CREATE PHO_DOR92FW.FOR | |
38492 | *COPY PHO_DOR92FW | |
38493 | CDECK ID>, PHO_DOR92FW | |
38494 | DOUBLE PRECISION FUNCTION PHO_DOR92FW(X,S, | |
38495 | & AL,BE,AK,BK,AG,BG,C,D,E,ES) | |
38496 | IMPLICIT DOUBLE PRECISION (A - Z) | |
38497 | SAVE | |
38498 | LX = LOG (1./X) | |
38499 | PHO_DOR92FW = (X**AK * (AG + X * (BG + X*C)) * LX**BK + S**AL | |
38500 | 1 * EXP (-E + SQRT (ES * S**BE * LX))) * (1.- X)**D | |
38501 | ||
38502 | END | |
38503 | ||
38504 | *$ CREATE PHO_DOR92FS.FOR | |
38505 | *COPY PHO_DOR92FS | |
38506 | CDECK ID>, PHO_DOR92FS | |
38507 | DOUBLE PRECISION FUNCTION PHO_DOR92FS(X,S,ST,AL,BE,AK,AG,B,D,E,ES) | |
38508 | IMPLICIT DOUBLE PRECISION (A - Z) | |
38509 | SAVE | |
38510 | ||
38511 | DX = SQRT (X) | |
38512 | LX = LOG (1./X) | |
38513 | IF (S .LE. ST) THEN | |
38514 | PHO_DOR92FS = 0.D0 | |
38515 | ELSE | |
38516 | PHO_DOR92FS = (S-ST)**AL/LX**AK*(1.D0+AG*DX+B*X)*(1.D0-X)**D | |
38517 | 1 * EXP (-E + SQRT (ES * S**BE * LX)) | |
38518 | END IF | |
38519 | ||
38520 | END | |
38521 | ||
38522 | *$ CREATE PHO_DORPLO.FOR | |
38523 | *COPY PHO_DORPLO | |
38524 | CDECK ID>, PHO_DORPLO | |
38525 | * | |
38526 | * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * | |
38527 | * * | |
38528 | * G R V - P I O N - P A R A M E T R I Z A T I O N S * | |
38529 | * * | |
38530 | * FOR A DETAILED EXPLANATION SEE : * | |
38531 | * M. GLUECK, E.REYA, A.VOGT: DO-TH 91/16 * | |
38532 | * * | |
38533 | * THE PARAMETRIZATIONS ARE FITTED TO THE PARTON DISTRIBUTIONS * | |
38534 | * FOR Q ** 2 BETWEEN MU ** 2 (= 0.25 / 0.30 GEV ** 2 IN LO * | |
38535 | * / HO) AND 1.E8 GEV ** 2 AND FOR X BETWEEN 1.E-5 AND 1. * | |
38536 | * REGIONS, WHERE THE DISTRIBUTION UNDER CONSIDERATION IS NEG- * | |
38537 | * LIGIBLE, I.E. BELOW ABOUT 1.E-4, WERE EXCLUDED FROM THE FIT. * | |
38538 | * * | |
38539 | * HEAVY QUARK THRESHOLDS Q(H) = M(H) : * | |
38540 | * M(C) = 1.5, M(B) = 4.5, M(T) = 100 GEV * | |
38541 | * * | |
38542 | * CORRESPONDING LAMBDA(F) VALUES FOR F ACTIVE FLAVOURS : * | |
38543 | * LO : LAMBDA(3) = 0.232, LAMBDA(4) = 0.200, * | |
38544 | * LAMBDA(5) = 0.153, LAMBDA(6) = 0.082 GEV * | |
38545 | * HO : LAMBDA(3) = 0.248, LAMBDA(4) = 0.200, * | |
38546 | * LAMBDA(5) = 0.131, LAMBDA(6) = 0.053 GEV * | |
38547 | * * | |
38548 | * HO DISTRIBUTION REFER TO THE MS-BAR SCHEME OF BARDEEN ET AL. * | |
38549 | * * | |
38550 | * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * | |
38551 | C | |
38552 | SUBROUTINE PHO_DORPLO (X, Q2, VAP, GLP, QBP, CBP, BBP) | |
38553 | IMPLICIT DOUBLE PRECISION (A - Z) | |
38554 | SAVE | |
38555 | ||
38556 | MU2 = 0.25 | |
38557 | LAM2 = 0.232 * 0.232 | |
38558 | S = LOG (LOG(Q2/LAM2) / LOG(MU2/LAM2)) | |
38559 | DS = SQRT (S) | |
38560 | S2 = S * S | |
38561 | C...X * VALENCE : | |
38562 | NV = 0.519 + 0.180 * S - 0.011 * S2 | |
38563 | AKV = 0.499 - 0.027 * S | |
38564 | AGV = 0.381 - 0.419 * S | |
38565 | DV = 0.367 + 0.563 * S | |
38566 | VAP = PHO_DORFVP (X, NV, AKV, AGV, DV) | |
38567 | C...X * GLUON : | |
38568 | ALG = 0.599 | |
38569 | BEG = 1.263 | |
38570 | AKG = 0.482 + 0.341 * DS | |
38571 | BKG = 0.0 | |
38572 | AGG = 0.678 + 0.877 * S - 0.175 * S2 | |
38573 | BGG = 0.338 - 1.597 * S | |
38574 | CG = 0.0 - 0.233 * S + 0.406 * S2 | |
38575 | DG = 0.390 + 1.053 * S | |
38576 | EG = 0.618 + 2.070 * S | |
38577 | ESG = 3.676 | |
38578 | GLP = PHO_DORFGP(X,S,ALG,BEG,AKG,BKG,AGG,BGG,CG,DG,EG,ESG) | |
38579 | C...X * QBAR (SU(3)-SYMMETRIC SEA) : | |
38580 | SL = 0.0 | |
38581 | ALS = 0.55 | |
38582 | BES = 0.56 | |
38583 | AKS = 2.538 - 0.763 * S | |
38584 | AGS = -0.748 | |
38585 | BS = 0.313 + 0.935 * S | |
38586 | DS = 3.359 | |
38587 | EST = 4.433 + 1.301 * S | |
38588 | ESS = 9.30 - 0.887 * S | |
38589 | QBP = PHO_DORFQP (X,S,SL,ALS,BES,AKS,AGS,BS,DS,EST,ESS) | |
38590 | C...X * CBAR = X * C : | |
38591 | SC = 0.888 | |
38592 | ALC = 1.02 | |
38593 | BEC = 0.39 | |
38594 | AKC = 0.0 | |
38595 | AGC = 0.0 | |
38596 | BC = 1.008 | |
38597 | DC = 1.208 + 0.771 * S | |
38598 | EC = 4.40 + 1.493 * S | |
38599 | ESC = 2.032 + 1.901 * S | |
38600 | CBP = PHO_DORFQP (X,S,SC,ALC,BEC,AKC,AGC,BC,DC,EC,ESC) | |
38601 | C...X * BBAR = X * B : | |
38602 | SBO = 1.351 | |
38603 | ALB = 1.03 | |
38604 | BEB = 0.39 | |
38605 | AKB = 0.0 | |
38606 | AGB = 0.0 | |
38607 | BBO = 0.0 | |
38608 | DB = 0.697 + 0.855 * S | |
38609 | EB = 4.51 + 1.490 * S | |
38610 | ESB = 3.056 + 1.694 * S | |
38611 | BBP = PHO_DORFQP(X,S,SBO,ALB,BEB,AKB,AGB,BBO,DB,EB,ESB) | |
38612 | ||
38613 | END | |
38614 | ||
38615 | *$ CREATE PHO_DORPHO.FOR | |
38616 | *COPY PHO_DORPHO | |
38617 | CDECK ID>, PHO_DORPHO | |
38618 | SUBROUTINE PHO_DORPHO (X, Q2, VAP, GLP, QBP, CBP, BBP) | |
38619 | IMPLICIT DOUBLE PRECISION (A - Z) | |
38620 | SAVE | |
38621 | ||
38622 | MU2 = 0.3 | |
38623 | LAM2 = 0.248 * 0.248 | |
38624 | S = LOG (LOG(Q2/LAM2) / LOG(MU2/LAM2)) | |
38625 | DS = SQRT (S) | |
38626 | S2 = S * S | |
38627 | C...X * VALENCE : | |
38628 | NV = 0.456 + 0.150 * DS + 0.112 * S - 0.019 * S2 | |
38629 | AKV = 0.505 - 0.033 * S | |
38630 | AGV = 0.748 - 0.669 * DS - 0.133 * S | |
38631 | DV = 0.365 + 0.197 * DS + 0.394 * S | |
38632 | VAP = PHO_DORFVP (X, NV, AKV, AGV, DV) | |
38633 | C...X * GLUON : | |
38634 | ALG = 1.096 | |
38635 | BEG = 1.371 | |
38636 | AKG = 0.437 - 0.689 * DS | |
38637 | BKG = -0.631 | |
38638 | AGG = 1.324 - 0.441 * DS - 0.130 * S | |
38639 | BGG = -0.955 + 0.259 * S | |
38640 | CG = 1.075 - 0.302 * S | |
38641 | DG = 1.158 + 1.229 * S | |
38642 | EG = 0.0 + 2.510 * S | |
38643 | ESG = 2.604 + 0.165 * S | |
38644 | GLP = PHO_DORFGP(X,S,ALG,BEG,AKG,BKG,AGG,BGG,CG,DG,EG,ESG) | |
38645 | C...X * QBAR (SU(3)-SYMMETRIC SEA) : | |
38646 | SL = 0.0 | |
38647 | ALS = 0.85 | |
38648 | BES = 0.96 | |
38649 | AKS = -0.350 + 0.806 * S | |
38650 | AGS = -1.663 | |
38651 | BS = 3.148 | |
38652 | DS = 2.273 + 1.438 * S | |
38653 | EST = 3.214 + 1.545 * S | |
38654 | ESS = 1.341 + 1.938 * S | |
38655 | QBP = PHO_DORFQP (X,S,SL,ALS,BES,AKS,AGS,BS,DS,EST,ESS) | |
38656 | C...X * CBAR = X * C : | |
38657 | SC = 0.820 | |
38658 | ALC = 0.98 | |
38659 | BEC = 0.0 | |
38660 | AKC = 0.0 - 0.457 * S | |
38661 | AGC = 0.0 | |
38662 | BC = -1.00 + 1.40 * S | |
38663 | DC = 1.318 + 0.584 * S | |
38664 | EC = 4.45 + 1.235 * S | |
38665 | ESC = 1.496 + 1.010 * S | |
38666 | CBP = PHO_DORFQP (X,S,SC,ALC,BEC,AKC,AGC,BC,DC,EC,ESC) | |
38667 | C...X * BBAR = X * B : | |
38668 | SBO = 1.297 | |
38669 | ALB = 0.99 | |
38670 | BEB = 0.0 | |
38671 | AKB = 0.0 - 0.172 * S | |
38672 | AGB = 0.0 | |
38673 | BBO = 0.0 | |
38674 | DB = 1.447 + 0.485 * S | |
38675 | EB = 4.79 + 1.164 * S | |
38676 | ESB = 1.724 + 2.121 * S | |
38677 | BBP = PHO_DORFQP(X,S,SBO,ALB,BEB,AKB,AGB,BBO,DB,EB,ESB) | |
38678 | ||
38679 | END | |
38680 | ||
38681 | *$ CREATE PHO_DORFVP.FOR | |
38682 | *COPY PHO_DORFVP | |
38683 | CDECK ID>, PHO_DORFVP | |
38684 | DOUBLE PRECISION FUNCTION PHO_DORFVP(X,N,AK,AG,D) | |
38685 | IMPLICIT DOUBLE PRECISION (A - Z) | |
38686 | SAVE | |
38687 | ||
38688 | DX = SQRT (X) | |
38689 | PHO_DORFVP = N * X**AK * (1.+ AG*DX) * (1.- X)**D | |
38690 | ||
38691 | END | |
38692 | ||
38693 | *$ CREATE PHO_DORFGP.FOR | |
38694 | *COPY PHO_DORFGP | |
38695 | CDECK ID>, PHO_DORFGP | |
38696 | DOUBLE PRECISION FUNCTION PHO_DORFGP(X,S,AL,BE,AK,BK,AG, | |
38697 | & BG,C,D,E,ES) | |
38698 | IMPLICIT DOUBLE PRECISION (A - Z) | |
38699 | SAVE | |
38700 | ||
38701 | DX = SQRT (X) | |
38702 | LX = LOG (1./X) | |
38703 | PHO_DORFGP = (X**AK * (AG + BG*DX + C*X) * LX**BK + S**AL | |
38704 | 1 * EXP (-E + SQRT (ES * S**BE * LX))) * (1.- X)**D | |
38705 | ||
38706 | END | |
38707 | ||
38708 | *$ CREATE PHO_DORFQP.FOR | |
38709 | *COPY PHO_DORFQP | |
38710 | CDECK ID>, PHO_DORFQP | |
38711 | DOUBLE PRECISION FUNCTION PHO_DORFQP(X,S,ST,AL,BE,AK,AG,B,D,E,ES) | |
38712 | IMPLICIT DOUBLE PRECISION (A - Z) | |
38713 | SAVE | |
38714 | ||
38715 | DX = SQRT (X) | |
38716 | LX = LOG (1./X) | |
38717 | IF (S .LE. ST) THEN | |
38718 | PHO_DORFQP = 0.0 | |
38719 | ELSE | |
38720 | PHO_DORFQP = (S-ST)**AL/LX**AK*(1.D0+AG*DX+B*X)*(1.D0-X)**D | |
38721 | 1 * EXP (-E + SQRT (ES * S**BE * LX)) | |
38722 | END IF | |
38723 | ||
38724 | END | |
38725 | ||
38726 | *$ CREATE PHO_DORGLO.FOR | |
38727 | *COPY PHO_DORGLO | |
38728 | CDECK ID>, PHO_DORGLO | |
38729 | * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * | |
38730 | * * | |
38731 | * G R V - P H O T O N - P A R A M E T R I Z A T I O N S * | |
38732 | * * | |
38733 | * FOR A DETAILED EXPLANATION SEE : * | |
38734 | * M. GLUECK, E.REYA, A.VOGT: DO-TH 91/31 * | |
38735 | * * | |
38736 | * THE OUTPUT IS ALWAYS 1./ ALPHA(EM) * X * PARTON DENSITY * | |
38737 | * * | |
38738 | * THE PARAMETRIZATIONS ARE FITTED TO THE PARTON DISTRIBUTIONS * | |
38739 | * FOR Q ** 2 BETWEEN MU ** 2 (= 0.25 / 0.30 GEV ** 2 IN LO * | |
38740 | * / HO) AND 1.E6 GEV ** 2 AND FOR X BETWEEN 1.E-5 AND 1. * | |
38741 | * * | |
38742 | * HEAVY QUARK THRESHOLDS Q(H) = M(H) : * | |
38743 | * M(C) = 1.5, M(B) = 4.5, M(T) = 100 GEV * | |
38744 | * * | |
38745 | * CORRESPONDING LAMBDA(F) VALUES FOR F ACTIVE FLAVOURS : * | |
38746 | * LO : LAMBDA(3) = 0.232, LAMBDA(4) = 0.200, * | |
38747 | * LAMBDA(5) = 0.153, LAMBDA(6) = 0.082 GEV * | |
38748 | * HO : LAMBDA(3) = 0.248, LAMBDA(4) = 0.200, * | |
38749 | * LAMBDA(5) = 0.131, LAMBDA(6) = 0.053 GEV * | |
38750 | * * | |
38751 | * HO DISTRIBUTIONS REFER TO THE DIS(GAMMA) SCHEME, SEE : * | |
38752 | * M. GLUECK, E.REYA, A.VOGT: DO-TH 91/26 * | |
38753 | * * | |
38754 | * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * | |
38755 | C | |
38756 | SUBROUTINE PHO_DORGLO (X, Q2, UL, DL, SL, CL, BL, GL) | |
38757 | IMPLICIT DOUBLE PRECISION (A - Z) | |
38758 | SAVE | |
38759 | ||
38760 | MU2 = 0.25 | |
38761 | LAM2 = 0.232 * 0.232 | |
38762 | S = LOG (LOG(Q2/LAM2) / LOG(MU2/LAM2)) | |
38763 | SS = SQRT (S) | |
38764 | S2 = S * S | |
38765 | C...X * U = X * UBAR : | |
38766 | AL = 1.717 | |
38767 | BE = 0.641 | |
38768 | AK = 0.500 - 0.176 * S | |
38769 | BK = 15.00 - 5.687 * SS - 0.552 * S2 | |
38770 | AG = 0.235 + 0.046 * SS | |
38771 | BG = 0.082 - 0.051 * S + 0.168 * S2 | |
38772 | C = 0.0 + 0.459 * S | |
38773 | D = 0.354 - 0.061 * S | |
38774 | E = 4.899 + 1.678 * S | |
38775 | ES = 2.046 + 1.389 * S | |
38776 | UL = PHO_DORGF (X, S, AL, BE, AK, BK, AG, BG, C, D, E, ES) | |
38777 | C...X * D = X * DBAR : | |
38778 | AL = 1.549 | |
38779 | BE = 0.782 | |
38780 | AK = 0.496 + 0.026 * S | |
38781 | BK = 0.685 - 0.580 * SS + 0.608 * S2 | |
38782 | AG = 0.233 + 0.302 * S | |
38783 | BG = 0.0 - 0.818 * S + 0.198 * S2 | |
38784 | C = 0.114 + 0.154 * S | |
38785 | D = 0.405 - 0.195 * S + 0.046 * S2 | |
38786 | E = 4.807 + 1.226 * S | |
38787 | ES = 2.166 + 0.664 * S | |
38788 | DL = PHO_DORGF (X, S, AL, BE, AK, BK, AG, BG, C, D, E, ES) | |
38789 | C...X * G : | |
38790 | AL = 0.676 | |
38791 | BE = 1.089 | |
38792 | AK = 0.462 - 0.524 * SS | |
38793 | BK = 5.451 - 0.804 * S2 | |
38794 | AG = 0.535 - 0.504 * SS + 0.288 * S2 | |
38795 | BG = 0.364 - 0.520 * S | |
38796 | C = -0.323 + 0.115 * S2 | |
38797 | D = 0.233 + 0.790 * S - 0.139 * S2 | |
38798 | E = 0.893 + 1.968 * S | |
38799 | ES = 3.432 + 0.392 * S | |
38800 | GL = PHO_DORGF (X, S, AL, BE, AK, BK, AG, BG, C, D, E, ES) | |
38801 | C...X * S = X * SBAR : | |
38802 | SF = 0.0 | |
38803 | AL = 1.609 | |
38804 | BE = 0.962 | |
38805 | AK = 0.470 - 0.099 * S2 | |
38806 | BK = 3.246 | |
38807 | AG = 0.121 - 0.068 * SS | |
38808 | BG = -0.090 + 0.074 * S | |
38809 | C = 0.062 + 0.034 * S | |
38810 | D = 0.0 + 0.226 * S - 0.060 * S2 | |
38811 | E = 4.288 + 1.707 * S | |
38812 | ES = 2.122 + 0.656 * S | |
38813 | SL = PHO_DORGFS (X, S, SF, AL, BE, AK, BK, AG, BG, C, D, E, ES) | |
38814 | C...X * C = X * CBAR : | |
38815 | SF = 0.888 | |
38816 | AL = 0.970 | |
38817 | BE = 0.545 | |
38818 | AK = 1.254 - 0.251 * S | |
38819 | BK = 3.932 - 0.327 * S2 | |
38820 | AG = 0.658 + 0.202 * S | |
38821 | BG = -0.699 | |
38822 | C = 0.965 | |
38823 | D = 0.0 + 0.141 * S - 0.027 * S2 | |
38824 | E = 4.911 + 0.969 * S | |
38825 | ES = 2.796 + 0.952 * S | |
38826 | CL = PHO_DORGFS (X, S, SF, AL, BE, AK, BK, AG, BG, C, D, E, ES) | |
38827 | C...X * B = X * BBAR : | |
38828 | SF = 1.351 | |
38829 | AL = 1.016 | |
38830 | BE = 0.338 | |
38831 | AK = 1.961 - 0.370 * S | |
38832 | BK = 0.923 + 0.119 * S | |
38833 | AG = 0.815 + 0.207 * S | |
38834 | BG = -2.275 | |
38835 | C = 1.480 | |
38836 | D = -0.223 + 0.173 * S | |
38837 | E = 5.426 + 0.623 * S | |
38838 | ES = 3.819 + 0.901 * S | |
38839 | BL = PHO_DORGFS (X, S, SF, AL, BE, AK, BK, AG, BG, C, D, E, ES) | |
38840 | ||
38841 | END | |
38842 | ||
38843 | *$ CREATE PHO_DORGHO.FOR | |
38844 | *COPY PHO_DORGHO | |
38845 | CDECK ID>, PHO_DORGHO | |
38846 | SUBROUTINE PHO_DORGHO (X, Q2, UH, DH, SH, CH, BH, GH) | |
38847 | IMPLICIT DOUBLE PRECISION (A - Z) | |
38848 | SAVE | |
38849 | ||
38850 | MU2 = 0.3 | |
38851 | LAM2 = 0.248 * 0.248 | |
38852 | S = LOG (LOG(Q2/LAM2) / LOG(MU2/LAM2)) | |
38853 | SS = SQRT (S) | |
38854 | S2 = S * S | |
38855 | C...X * U = X * UBAR : | |
38856 | AL = 0.583 | |
38857 | BE = 0.688 | |
38858 | AK = 0.449 - 0.025 * S - 0.071 * S2 | |
38859 | BK = 5.060 - 1.116 * SS | |
38860 | AG = 0.103 | |
38861 | BG = 0.319 + 0.422 * S | |
38862 | C = 1.508 + 4.792 * S - 1.963 * S2 | |
38863 | D = 1.075 + 0.222 * SS - 0.193 * S2 | |
38864 | E = 4.147 + 1.131 * S | |
38865 | ES = 1.661 + 0.874 * S | |
38866 | UH = PHO_DORGF (X, S, AL, BE, AK, BK, AG, BG, C, D, E, ES) | |
38867 | C...X * D = X * DBAR : | |
38868 | AL = 0.591 | |
38869 | BE = 0.698 | |
38870 | AK = 0.442 - 0.132 * S - 0.058 * S2 | |
38871 | BK = 5.437 - 1.916 * SS | |
38872 | AG = 0.099 | |
38873 | BG = 0.311 - 0.059 * S | |
38874 | C = 0.800 + 0.078 * S - 0.100 * S2 | |
38875 | D = 0.862 + 0.294 * SS - 0.184 * S2 | |
38876 | E = 4.202 + 1.352 * S | |
38877 | ES = 1.841 + 0.990 * S | |
38878 | DH = PHO_DORGF (X, S, AL, BE, AK, BK, AG, BG, C, D, E, ES) | |
38879 | C...X * G : | |
38880 | AL = 1.161 | |
38881 | BE = 1.591 | |
38882 | AK = 0.530 - 0.742 * SS + 0.025 * S2 | |
38883 | BK = 5.662 | |
38884 | AG = 0.533 - 0.281 * SS + 0.218 * S2 | |
38885 | BG = 0.025 - 0.518 * S + 0.156 * S2 | |
38886 | C = -0.282 + 0.209 * S2 | |
38887 | D = 0.107 + 1.058 * S - 0.218 * S2 | |
38888 | E = 0.0 + 2.704 * S | |
38889 | ES = 3.071 - 0.378 * S | |
38890 | GH = PHO_DORGF (X, S, AL, BE, AK, BK, AG, BG, C, D, E, ES) | |
38891 | C...X * S = X * SBAR : | |
38892 | SF = 0.0 | |
38893 | AL = 0.635 | |
38894 | BE = 0.456 | |
38895 | AK = 1.770 - 0.735 * SS - 0.079 * S2 | |
38896 | BK = 3.832 | |
38897 | AG = 0.084 - 0.023 * S | |
38898 | BG = 0.136 | |
38899 | C = 2.119 - 0.942 * S + 0.063 * S2 | |
38900 | D = 1.271 + 0.076 * S - 0.190 * S2 | |
38901 | E = 4.604 + 0.737 * S | |
38902 | ES = 1.641 + 0.976 * S | |
38903 | SH = PHO_DORGFS (X, S, SF, AL, BE, AK, BK, AG, BG, C, D, E, ES) | |
38904 | C...X * C = X * CBAR : | |
38905 | SF = 0.820 | |
38906 | AL = 0.926 | |
38907 | BE = 0.152 | |
38908 | AK = 1.142 - 0.175 * S | |
38909 | BK = 3.276 | |
38910 | AG = 0.504 + 0.317 * S | |
38911 | BG = -0.433 | |
38912 | C = 3.334 | |
38913 | D = 0.398 + 0.326 * S - 0.107 * S2 | |
38914 | E = 5.493 + 0.408 * S | |
38915 | ES = 2.426 + 1.277 * S | |
38916 | CH = PHO_DORGFS (X, S, SF, AL, BE, AK, BK, AG, BG, C, D, E, ES) | |
38917 | C...X * B = X * BBAR : | |
38918 | SF = 1.297 | |
38919 | AL = 0.969 | |
38920 | BE = 0.266 | |
38921 | AK = 1.953 - 0.391 * S | |
38922 | BK = 1.657 - 0.161 * S | |
38923 | AG = 1.076 + 0.034 * S | |
38924 | BG = -2.015 | |
38925 | C = 1.662 | |
38926 | D = 0.353 + 0.016 * S | |
38927 | E = 5.713 + 0.249 * S | |
38928 | ES = 3.456 + 0.673 * S | |
38929 | BH = PHO_DORGFS (X, S, SF, AL, BE, AK, BK, AG, BG, C, D, E, ES) | |
38930 | ||
38931 | END | |
38932 | ||
38933 | *$ CREATE PHO_DORGH0.FOR | |
38934 | *COPY PHO_DORGH0 | |
38935 | CDECK ID>, PHO_DORGH0 | |
38936 | SUBROUTINE PHO_DORGH0 (X, Q2, U0, D0, S0, C0, B0, G0) | |
38937 | IMPLICIT DOUBLE PRECISION (A - Z) | |
38938 | SAVE | |
38939 | ||
38940 | MU2 = 0.3 | |
38941 | LAM2 = 0.248 * 0.248 | |
38942 | S = LOG (LOG(Q2/LAM2) / LOG(MU2/LAM2)) | |
38943 | SS = SQRT (S) | |
38944 | S2 = S * S | |
38945 | C...X * U = X * UBAR : | |
38946 | AL = 1.447 | |
38947 | BE = 0.848 | |
38948 | AK = 0.527 + 0.200 * S - 0.107 * S2 | |
38949 | BK = 7.106 - 0.310 * SS - 0.786 * S2 | |
38950 | AG = 0.197 + 0.533 * S | |
38951 | BG = 0.062 - 0.398 * S + 0.109 * S2 | |
38952 | C = 0.755 * S - 0.112 * S2 | |
38953 | D = 0.318 - 0.059 * S | |
38954 | E = 4.225 + 1.708 * S | |
38955 | ES = 1.752 + 0.866 * S | |
38956 | U0 = PHO_DORGF (X, S, AL, BE, AK, BK, AG, BG, C, D, E, ES) | |
38957 | C...X * D = X * DBAR : | |
38958 | AL = 1.424 | |
38959 | BE = 0.770 | |
38960 | AK = 0.500 + 0.067 * SS - 0.055 * S2 | |
38961 | BK = 0.376 - 0.453 * SS + 0.405 * S2 | |
38962 | AG = 0.156 + 0.184 * S | |
38963 | BG = 0.0 - 0.528 * S + 0.146 * S2 | |
38964 | C = 0.121 + 0.092 * S | |
38965 | D = 0.379 - 0.301 * S + 0.081 * S2 | |
38966 | E = 4.346 + 1.638 * S | |
38967 | ES = 1.645 + 1.016 * S | |
38968 | D0 = PHO_DORGF (X, S, AL, BE, AK, BK, AG, BG, C, D, E, ES) | |
38969 | C...X * G : | |
38970 | AL = 0.661 | |
38971 | BE = 0.793 | |
38972 | AK = 0.537 - 0.600 * SS | |
38973 | BK = 6.389 - 0.953 * S2 | |
38974 | AG = 0.558 - 0.383 * SS + 0.261 * S2 | |
38975 | BG = 0.0 - 0.305 * S | |
38976 | C = -0.222 + 0.078 * S2 | |
38977 | D = 0.153 + 0.978 * S - 0.209 * S2 | |
38978 | E = 1.429 + 1.772 * S | |
38979 | ES = 3.331 + 0.806 * S | |
38980 | G0 = PHO_DORGF (X, S, AL, BE, AK, BK, AG, BG, C, D, E, ES) | |
38981 | C...X * S = X * SBAR : | |
38982 | SF = 0.0 | |
38983 | AL = 1.578 | |
38984 | BE = 0.863 | |
38985 | AK = 0.622 + 0.332 * S - 0.300 * S2 | |
38986 | BK = 2.469 | |
38987 | AG = 0.211 - 0.064 * SS - 0.018 * S2 | |
38988 | BG = -0.215 + 0.122 * S | |
38989 | C = 0.153 | |
38990 | D = 0.0 + 0.253 * S - 0.081 * S2 | |
38991 | E = 3.990 + 2.014 * S | |
38992 | ES = 1.720 + 0.986 * S | |
38993 | S0 = PHO_DORGFS (X, S, SF, AL, BE, AK, BK, AG, BG, C, D, E, ES) | |
38994 | C...X * C = X * CBAR : | |
38995 | SF = 0.820 | |
38996 | AL = 0.929 | |
38997 | BE = 0.381 | |
38998 | AK = 1.228 - 0.231 * S | |
38999 | BK = 3.806 - 0.337 * S2 | |
39000 | AG = 0.932 + 0.150 * S | |
39001 | BG = -0.906 | |
39002 | C = 1.133 | |
39003 | D = 0.0 + 0.138 * S - 0.028 * S2 | |
39004 | E = 5.588 + 0.628 * S | |
39005 | ES = 2.665 + 1.054 * S | |
39006 | C0 = PHO_DORGFS (X, S, SF, AL, BE, AK, BK, AG, BG, C, D, E, ES) | |
39007 | C...X * B = X * BBAR : | |
39008 | SF = 1.297 | |
39009 | AL = 0.970 | |
39010 | BE = 0.207 | |
39011 | AK = 1.719 - 0.292 * S | |
39012 | BK = 0.928 + 0.096 * S | |
39013 | AG = 0.845 + 0.178 * S | |
39014 | BG = -2.310 | |
39015 | C = 1.558 | |
39016 | D = -0.191 + 0.151 * S | |
39017 | E = 6.089 + 0.282 * S | |
39018 | ES = 3.379 + 1.062 * S | |
39019 | B0 = PHO_DORGFS (X, S, SF, AL, BE, AK, BK, AG, BG, C, D, E, ES) | |
39020 | ||
39021 | END | |
39022 | ||
39023 | *$ CREATE PHO_DORGF.FOR | |
39024 | *COPY PHO_DORGF | |
39025 | CDECK ID>, PHO_DORGF | |
39026 | DOUBLE PRECISION FUNCTION PHO_DORGF(X,S,AL,BE,AK,BK, | |
39027 | & AG,BG,C,D,E,ES) | |
39028 | IMPLICIT DOUBLE PRECISION (A - Z) | |
39029 | SAVE | |
39030 | ||
39031 | SX = SQRT (X) | |
39032 | LX = LOG (1./X) | |
39033 | PHO_DORGF = (X**AK * (AG + BG * SX + C * X**BK) + S**AL | |
39034 | 1 * EXP (-E + SQRT (ES * S**BE * LX))) * (1.- X)**D | |
39035 | ||
39036 | END | |
39037 | ||
39038 | *$ CREATE PHO_DORGFS.FOR | |
39039 | *COPY PHO_DORGFS | |
39040 | CDECK ID>, PHO_DORGFS | |
39041 | DOUBLE PRECISION FUNCTION PHO_DORGFS(X,S,SF,AL,BE,AK,BK,AG,BG, | |
39042 | & C,D,E,ES) | |
39043 | IMPLICIT DOUBLE PRECISION (A - Z) | |
39044 | SAVE | |
39045 | ||
39046 | IF (S .LE. SF) THEN | |
39047 | PHO_DORGFS = 0.0 | |
39048 | ELSE | |
39049 | SX = SQRT (X) | |
39050 | LX = LOG (1./X) | |
39051 | DS = S - SF | |
39052 | PHO_DORGFS = (DS * X**AK * (AG + BG * SX + C * X**BK) + DS**AL | |
39053 | 1 * EXP (-E + SQRT (ES * S**BE * LX))) * (1.- X)**D | |
39054 | END IF | |
39055 | ||
39056 | END | |
39057 | ||
39058 | *$ CREATE PHO_DORGLV.FOR | |
39059 | *COPY PHO_DORGLV | |
39060 | CDECK ID>, PHO_DORGLV | |
39061 | * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * | |
39062 | * * | |
39063 | * G R S - LO - VIRTUAL PHOTON PARAMETRIZATIONS * | |
39064 | * * | |
39065 | * FOR A DETAILED EXPLANATION SEE * | |
39066 | * M. GLUECK, E.REYA, M. STRATMANN : * | |
39067 | * PHYS. REV. D51 (1995) 3220 * | |
39068 | * * | |
39069 | * THE PARAMETRIZATIONS ARE FITTED TO THE EVOLVED PARTONS FOR * | |
39070 | * Q**2 / GEV**2 BETWEEN 0.6 AND 5.E4 * | |
39071 | * AND (!) Q**2 > 5 P**2 * | |
39072 | * P**2 / GEV**2 BETWEEN 0.0 AND 10. * | |
39073 | * P**2 = 0 <=> REAL PHOTON * | |
39074 | * X BETWEEN 1.E-4 AND 1. * | |
39075 | * * | |
39076 | * HEAVY QUARK THRESHOLDS Q(H) = M(H) IN THE BETA FUNCTION : * | |
39077 | * M(C) = 1.5, M(B) = 4.5 * | |
39078 | * CORRESPONDING LAMBDA(F) VALUES IN GEV FOR Q**2 > M(H)**2 : * | |
39079 | * LO : LAMBDA(3) = 0.232, LAMBDA(4) = 0.200, * | |
39080 | * LAMBDA(5) = 0.153, * | |
39081 | * THE NUMBER OF ACTIVE QUARK FLAVOURS IS NF = 3 EVERYWHERE * | |
39082 | * EXCEPT IN THE BETA FUNCTION, I.E. THE HEAVY QUARKS C,B,... * | |
39083 | * ARE NOT PRESENT AS PARTONS IN THE Q2-EVOLUTION. * | |
39084 | * * | |
39085 | * PLEASE REPORT ANY STRANGE BEHAVIOUR TO : * | |
39086 | * Marco.Stratmann@durham.ac.uk * | |
39087 | * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * | |
39088 | * | |
39089 | *...INPUT PARAMETERS : | |
39090 | * | |
39091 | * X = MOMENTUM FRACTION | |
39092 | * Q2 = SCALE Q**2 IN GEV**2 | |
39093 | * P2 = VIRTUALITY OF THE PHOTON IN GEV**2 | |
39094 | * | |
39095 | *...OUTPUT (ALWAYS X TIMES THE DISTRIBUTION DIVIDED BY ALPHA_EM) : | |
39096 | * | |
39097 | ******************************************************** | |
39098 | * subroutine grspar(x,q2,p2,ugam,dgam,sgam,ggam) | |
39099 | subroutine PHO_DORGLV(x,q2,p2,ugam,dgam,sgam,ggam) | |
39100 | implicit double precision (a-z) | |
39101 | save | |
39102 | ||
39103 | C input/output channels | |
39104 | INTEGER LI,LO | |
39105 | COMMON /POINOU/ LI,LO | |
39106 | ||
39107 | integer check | |
39108 | c | |
39109 | c check limits : | |
39110 | c | |
39111 | check=0 | |
39112 | if(x.lt.0.0001d0) check=1 | |
39113 | if((q2.lt.0.6d0).or.(q2.gt.50000.d0)) check=1 | |
39114 | if(q2.lt.5.d0*p2) check=1 | |
39115 | c | |
39116 | c calculate distributions | |
39117 | c | |
39118 | if(check.eq.0) then | |
39119 | call PHO_grscalc(x,q2,p2,ugam,dgam,sgam,ggam) | |
39120 | else | |
39121 | WRITE(LO,*) 'GRS PDF parametrization: x/q2/p2 limits exceeded' | |
39122 | WRITE(LO,'(1X,A,1P,3E12.3)') 'current X, Q2, P2:',x,q2,p2 | |
39123 | endif | |
39124 | ||
39125 | end | |
39126 | ||
39127 | *$ CREATE PHO_grscalc.FOR | |
39128 | *COPY PHO_grscalc | |
39129 | CDECK ID>, PHO_grscalc | |
39130 | subroutine PHO_grscalc(x,q2,p2,ugam,dgam,sgam,ggam) | |
39131 | implicit double precision (a-z) | |
39132 | save | |
39133 | ||
39134 | dimension u1(40),ds1(40),g1(40) | |
39135 | dimension ud2(20),s2(20),g2(20) | |
39136 | dimension up0(20),dsp0(20),gp0(20) | |
454792a9 | 39137 | CPH save u1,ds1,g1,ud2,s2,g2,up0,dsp0,gp0 |
9aaba0d6 | 39138 | c |
39139 | data u1/-0.139d0,0.783d0,0.132d0,0.087d0,0.003d0,-0.0134d0, | |
39140 | & 0.009d0,-0.017d0,0.092d0,-0.516d0,-0.085d0,0.439d0, | |
39141 | & 0.013d0,0.108d0,-0.019d0,-0.272d0,-0.167d0,0.138d0, | |
39142 | & 0.076d0,0.026d0,-0.013d0,0.27d0,0.107d0,-0.097d0,0.04d0, | |
39143 | & 0.064d0,0.011d0,0.002d0,0.057d0,-0.057d0,0.162d0, | |
39144 | & -0.172d0,0.124d0,-0.016d0,-0.065d0,0.044d0,-1.009d0, | |
39145 | & 0.622d0,0.227d0,-0.184d0/ | |
39146 | data ds1/0.033d0,0.007d0,-0.0516d0,0.12d0,0.001d0,-0.013d0, | |
39147 | & 0.018d0,-0.028d0,0.102d0,-0.595d0,-0.114d0,0.669d0, | |
39148 | & 0.022d0,0.001d0,-0.003d0,-0.0583d0,-0.041d0,0.035d0, | |
39149 | & 0.009d0,0.009d0,0.004d0,0.054d0,0.025d0,-0.02d0, | |
39150 | & 0.007d0,0.021d0,0.01d0,0.004d0,-0.067d0,0.06d0,-0.148d0, | |
39151 | & 0.13d0,0.032d0,-0.009d0,-0.06d0,0.036d0,-0.39d0,0.033d0, | |
39152 | & 0.245d0,-0.171d0/ | |
39153 | data g1/0.025d0,0.d0,-0.018d0,0.112d0,-0.025d0,0.177d0, | |
39154 | & -0.022d0,0.024d0,0.001d0,-0.0104d0,0.d0,0.d0,-1.082d0, | |
39155 | & -1.666d0,0.d0,0.086d0,0.d0,0.053d0,0.005d0,-0.058d0, | |
39156 | & 0.034d0,0.073d0,1.08d0,1.63d0,-0.0256d0,-0.088d0,0.d0, | |
39157 | & 0.d0,-0.004d0,0.016d0,0.007d0,-0.012d0,0.01d0,-0.673d0, | |
39158 | & 0.126d0,-0.167d0,0.032d0,-0.227d0,0.086d0,-0.159d0/ | |
39159 | data ud2/0.756d0,0.187d0,0.109d0,-0.163d0,0.002d0,0.004d0, | |
39160 | & 0.054d0,-0.039d0,22.53d0,-21.02d0,5.608d0,0.332d0, | |
39161 | & -0.008d0,-0.021d0,0.381d0,0.572d0,4.774d0,1.436d0, | |
39162 | & -0.614d0,3.548d0/ | |
39163 | data s2/0.902d0,0.182d0,0.271d0,-0.346d0,0.017d0,-0.01d0, | |
39164 | & -0.011d0,0.0065d0,17.1d0,-13.29d0,6.519d0,0.031d0, | |
39165 | & -0.0176d0,0.003d0,1.243d0,0.804d0,4.709d0,1.499d0, | |
39166 | & -0.48d0,3.401d0/ | |
39167 | data g2/0.364d0,1.31d0,0.86d0,-0.254d0,0.611d0,0.008d0, | |
39168 | & -0.097d0,-2.412d0,-0.843d0,2.248d0,-0.201d0,1.33d0, | |
39169 | & 0.572d0,0.44d0,1.233d0,0.009d0,0.954d0,1.862d0,3.791d0, | |
39170 | & -0.079d0/ | |
39171 | data up0/1.551d0,0.105d0,1.089d0,-0.172d0,3.822d0,-2.162d0, | |
39172 | & 0.533d0,-0.467d0,-0.412d0,0.2d0,0.377d0,0.299d0,0.487d0, | |
39173 | & 0.0766d0,0.119d0,0.063d0,7.605d0,0.234d0,-0.567d0, | |
39174 | & 2.294d0/ | |
39175 | data dsp0/2.484d0,1.214d0,1.088d0,-0.1735d0,4.293d0, | |
39176 | & -2.802d0,0.5975d0,-0.1193d0,-0.0872d0,0.0418d0,0.128d0, | |
39177 | & 0.0337d0,0.127d0,0.0135d0,0.14d0,0.0423d0,6.946d0, | |
39178 | & 0.814d0,1.531d0,0.124d0/ | |
39179 | data gp0/1.682d0,1.1d0,0.5888d0,-0.4714d0,0.5362d0,0.0127d0, | |
39180 | & -2.438d0,0.03399d0,0.07825d0,0.05842d0,0.08393d0,2.348d0, | |
39181 | & -0.07182d0,1.084d0,0.3098d0,-0.07514d0,3.327d0,1.1d0, | |
39182 | & 2.264d0,0.2675d0/ | |
39183 | c | |
39184 | mu2=0.25d0 | |
39185 | lam2=0.232d0*0.232d0 | |
39186 | c | |
39187 | if(p2.le.0.25d0) then | |
39188 | s=log(log(q2/lam2)/log(mu2/lam2)) | |
39189 | lp1=0.d0 | |
39190 | lp2=0.d0 | |
39191 | else | |
39192 | s=log(log(q2/lam2)/log(p2/lam2)) | |
39193 | lp1=log(p2/mu2)*log(p2/mu2) | |
39194 | lp2=log(p2/mu2+log(p2/mu2)) | |
39195 | endif | |
39196 | c | |
39197 | alp=up0(1)+lp1*u1(1)+lp2*u1(2) | |
39198 | bet=up0(2)+lp1*u1(3)+lp2*u1(4) | |
39199 | a=up0(3)+lp1*u1(5)+lp2*u1(6)+ | |
39200 | & (up0(4)+lp1*u1(7)+lp2*u1(8))*s | |
39201 | b=up0(5)+lp1*u1(9)+lp2*u1(10)+ | |
39202 | & (up0(6)+lp1*u1(11)+lp2*u1(12))*s**0.5+ | |
39203 | & (up0(7)+lp1*u1(13)+lp2*u1(14))*s**2 | |
39204 | gb=up0(8)+lp1*u1(15)+lp2*u1(16)+ | |
39205 | & (up0(9)+lp1*u1(17)+lp2*u1(18))*s+ | |
39206 | & (up0(10)+lp1*u1(19)+lp2*u1(20))*s**2 | |
39207 | ga=up0(11)+lp1*u1(21)+lp2*u1(22)+ | |
39208 | & (up0(12)+lp1*u1(23)+lp2*u1(24))*s**0.5 | |
39209 | gc=up0(13)+lp1*u1(25)+lp2*u1(33)+ | |
39210 | & (up0(14)+lp1*u1(26)+lp2*u1(34))*s | |
39211 | gd=up0(15)+lp1*u1(27)+lp2*u1(35)+ | |
39212 | & (up0(16)+lp1*u1(28)+lp2*u1(36))*s | |
39213 | ge=up0(17)+lp1*u1(29)+lp2*u1(37)+ | |
39214 | & (up0(18)+lp1*u1(30)+lp2*u1(38))*s | |
39215 | gep=up0(19)+lp1*u1(31)+lp2*u1(39)+ | |
39216 | & (up0(20)+lp1*u1(32)+lp2*u1(40))*s | |
39217 | upart1=PHO_grsf2(x,s,alp,bet,a,b,ga,gb,gc,gd,ge,gep) | |
39218 | c | |
39219 | alp=dsp0(1)+lp1*ds1(1)+lp2*ds1(2) | |
39220 | bet=dsp0(2)+lp1*ds1(3)+lp2*ds1(4) | |
39221 | a=dsp0(3)+lp1*ds1(5)+lp2*ds1(6)+ | |
39222 | & (dsp0(4)+lp1*ds1(7)+lp2*ds1(8))*s | |
39223 | b=dsp0(5)+lp1*ds1(9)+lp2*ds1(10)+ | |
39224 | & (dsp0(6)+lp1*ds1(11)+lp2*ds1(12))*s**0.5+ | |
39225 | & (dsp0(7)+lp1*ds1(13)+lp2*ds1(14))*s**2 | |
39226 | gb=dsp0(8)+lp1*ds1(15)+lp2*ds1(16)+ | |
39227 | & (dsp0(9)+lp1*ds1(17)+lp2*ds1(18))*s+ | |
39228 | & (dsp0(10)+lp1*ds1(19)+lp2*ds1(20))*s**2 | |
39229 | ga=dsp0(11)+lp1*ds1(21)+lp2*ds1(22)+ | |
39230 | & (dsp0(12)+lp1*ds1(23)+lp2*ds1(24))*s | |
39231 | gc=dsp0(13)+lp1*ds1(25)+lp2*ds1(33)+ | |
39232 | & (dsp0(14)+lp1*ds1(26)+lp2*ds1(34))*s | |
39233 | gd=dsp0(15)+lp1*ds1(27)+lp2*ds1(35)+ | |
39234 | & (dsp0(16)+lp1*ds1(28)+lp2*ds1(36))*s | |
39235 | ge=dsp0(17)+lp1*ds1(29)+lp2*ds1(37)+ | |
39236 | & (dsp0(18)+lp1*ds1(30)+lp2*ds1(38))*s | |
39237 | gep=dsp0(19)+lp1*ds1(31)+lp2*ds1(39)+ | |
39238 | & (dsp0(20)+lp1*ds1(32)+lp2*ds1(40))*s | |
39239 | dspart1=PHO_grsf2(x,s,alp,bet,a,b,ga,gb,gc,gd,ge,gep) | |
39240 | c | |
39241 | alp=gp0(1)+lp1*g1(1)+lp2*g1(2) | |
39242 | bet=gp0(2)+lp1*g1(3)+lp2*g1(4) | |
39243 | a=gp0(3)+lp1*g1(5)+lp2*g1(6)+ | |
39244 | & (gp0(4)+lp1*g1(7)+lp2*g1(8))*s**0.5 | |
39245 | b=gp0(5)+lp1*g1(9)+lp2*g1(10)+ | |
39246 | & (gp0(6)+lp1*g1(11)+lp2*g1(12))*s**2 | |
39247 | gb=gp0(7)+lp1*g1(13)+lp2*g1(14)+ | |
39248 | & (gp0(8)+lp1*g1(15)+lp2*g1(16))*s | |
39249 | ga=gp0(9)+lp1*g1(17)+lp2*g1(18)+ | |
39250 | & (gp0(10)+lp1*g1(19)+lp2*g1(20))*s**0.5+ | |
39251 | & (gp0(11)+lp1*g1(21)+lp2*g1(22))*s**2 | |
39252 | gc=gp0(12)+lp1*g1(23)+lp2*g1(24)+ | |
39253 | & (gp0(13)+lp1*g1(25)+lp2*g1(26))*s**2 | |
39254 | gd=gp0(14)+lp1*g1(27)+lp2*g1(28)+ | |
39255 | & (gp0(15)+lp1*g1(29)+lp2*g1(30))*s+ | |
39256 | & (gp0(16)+lp1*g1(31)+lp2*g1(32))*s**2 | |
39257 | ge=gp0(17)+lp1*g1(33)+lp2*g1(34)+ | |
39258 | & (gp0(18)+lp1*g1(35)+lp2*g1(36))*s | |
39259 | gep=gp0(19)+lp1*g1(37)+lp2*g1(38)+ | |
39260 | & (gp0(20)+lp1*g1(39)+lp2*g1(40))*s | |
39261 | gpart1=PHO_grsf2(x,s,alp,bet,a,b,ga,gb,gc,gd,ge,gep) | |
39262 | c | |
39263 | s=log(log(q2/lam2)/log(mu2/lam2)) | |
39264 | suppr=1.d0/(1.d0+p2/0.59d0)**2 | |
39265 | c | |
39266 | alp=ud2(1) | |
39267 | bet=ud2(2) | |
39268 | a=ud2(3)+ud2(4)*s | |
39269 | ga=ud2(5)+ud2(6)*s**0.5 | |
39270 | gc=ud2(7)+ud2(8)*s | |
39271 | b=ud2(9)+ud2(10)*s+ud2(11)*s**2 | |
39272 | gb=ud2(12)+ud2(13)*s+ud2(14)*s**2 | |
39273 | gd=ud2(15)+ud2(16)*s | |
39274 | ge=ud2(17)+ud2(18)*s | |
39275 | gep=ud2(19)+ud2(20)*s | |
39276 | udpart2=suppr*PHO_grsf1(x,s,alp,bet,a,b,ga,gb,gc,gd,ge,gep) | |
39277 | c | |
39278 | alp=s2(1) | |
39279 | bet=s2(2) | |
39280 | a=s2(3)+s2(4)*s | |
39281 | ga=s2(5)+s2(6)*s**0.5 | |
39282 | gc=s2(7)+s2(8)*s | |
39283 | b=s2(9)+s2(10)*s+s2(11)*s**2 | |
39284 | gb=s2(12)+s2(13)*s+s2(14)*s**2 | |
39285 | gd=s2(15)+s2(16)*s | |
39286 | ge=s2(17)+s2(18)*s | |
39287 | gep=s2(19)+s2(20)*s | |
39288 | spart2=suppr*PHO_grsf2(x,s,alp,bet,a,b,ga,gb,gc,gd,ge,gep) | |
39289 | c | |
39290 | alp=g2(1) | |
39291 | bet=g2(2) | |
39292 | a=g2(3)+g2(4)*s**0.5 | |
39293 | b=g2(5)+g2(6)*s**2 | |
39294 | gb=g2(7)+g2(8)*s | |
39295 | ga=g2(9)+g2(10)*s**0.5+g2(11)*s**2 | |
39296 | gc=g2(12)+g2(13)*s**2 | |
39297 | gd=g2(14)+g2(15)*s+g2(16)*s**2 | |
39298 | ge=g2(17)+g2(18)*s | |
39299 | gep=g2(19)+g2(20)*s | |
39300 | gpart2=suppr*PHO_grsf1(x,s,alp,bet,a,b,ga,gb,gc,gd,ge,gep) | |
39301 | c | |
39302 | ugam=upart1+udpart2 | |
39303 | dgam=dspart1+udpart2 | |
39304 | sgam=dspart1+spart2 | |
39305 | ggam=gpart1+gpart2 | |
39306 | c | |
39307 | end | |
39308 | ||
39309 | *$ CREATE PHO_grsf1.FOR | |
39310 | *COPY PHO_grsf1 | |
39311 | CDECK ID>, PHO_grsf1 | |
39312 | DOUBLE PRECISION FUNCTION PHO_grsf1(x,s,alp,bet,a,b,ga,gb,gc,gd, | |
39313 | & ge,gep) | |
39314 | implicit double precision (a-z) | |
39315 | save | |
39316 | ||
39317 | PHO_grsf1=(x**a*(ga+gb*sqrt(x)+gc*x**b)+ | |
39318 | & s**alp*exp(-ge+sqrt(gep*s**bet*log(1.d0/x))))* | |
39319 | & (1.d0-x)**gd | |
39320 | ||
39321 | end | |
39322 | ||
39323 | *$ CREATE PHO_grsf2.FOR | |
39324 | *COPY PHO_grsf2 | |
39325 | CDECK ID>, PHO_grsf2 | |
39326 | DOUBLE PRECISION FUNCTION PHO_grsf2(x,s,alp,bet,a,b,ga,gb,gc,gd, | |
39327 | & ge,gep) | |
39328 | implicit double precision (a-z) | |
39329 | save | |
39330 | ||
39331 | PHO_grsf2=(s*x**a*(ga+gb*sqrt(x)+gc*x**b)+ | |
39332 | & s**alp*exp(-ge+sqrt(gep*s**bet*log(1.d0/x))))* | |
39333 | & (1.d0-x)**gd | |
39334 | ||
39335 | end | |
39336 | ||
39337 | *$ CREATE PHO_CKMTPA.FOR | |
39338 | *COPY PHO_CKMTPA | |
39339 | CDECK ID>, PHO_CKMTPA | |
39340 | SUBROUTINE PHO_CKMTPA(IPA,XMI,XMA,ALA,Q2MI,Q2MA,PDFNA) | |
39341 | C********************************************************************** | |
39342 | C | |
39343 | C PDF based on Regge theory, evolved with .... by .... | |
39344 | C | |
39345 | C input: IPAR 2212 proton (not installed) | |
39346 | C 990 Pomeron | |
39347 | C | |
39348 | C output: parameters of parametrization | |
39349 | C | |
39350 | C********************************************************************** | |
39351 | IMPLICIT DOUBLE PRECISION (A-H,O-Z) | |
39352 | SAVE | |
39353 | ||
39354 | CHARACTER*8 PDFNA | |
39355 | ||
39356 | C input/output channels | |
39357 | INTEGER LI,LO | |
39358 | COMMON /POINOU/ LI,LO | |
39359 | ||
39360 | REAL PROP(40),POMP(40) | |
39361 | DATA PROP / | |
39362 | & .230000E+00, .200000E+01, .150200E+00, .120000E+01, .263100E+00, | |
39363 | & .645200E+00, .354890E+01, .111700E+01, .415000E+00, .768400E-01, | |
39364 | & .100000E+00, .330000E-01, .352102E-01, .200000E+01, .200000E+01, | |
39365 | & .000000E+00, .000000E+00, .000000E+00, .000000E+00, .000000E+00, | |
39366 | & .000000E+00, .000000E+00, .000000E+00, .000000E+00, .000000E+00, | |
39367 | & .000000E+00, .000000E+00, .000000E+00, .000000E+00, .000000E+00, | |
39368 | & .000000E+00, .000000E+00, .000000E+00, .000000E+00, .000000E+00, | |
39369 | & .000000E+00, .000000E+00, .100000E+00, .200000E+01, .100000E+09/ | |
39370 | DATA POMP / | |
39371 | & .230000E+00, .500000E+01, .150200E+00, .120000E+01, .263100E+00, | |
39372 | & .645200E+00, .354890E+01, .111700E+01, .415000E+00, .768400E-01, | |
39373 | & .700000E-01, .700000E-01, .137161E+00, .300000E+01, .200000E+01, | |
39374 | & .000000E+00, .000000E+00, .000000E+00, .000000E+00, .000000E+00, | |
39375 | & .000000E+00, .000000E+00, .000000E+00, .000000E+00, .000000E+00, | |
39376 | & .000000E+00, .000000E+00, .000000E+00, .000000E+00, .000000E+00, | |
39377 | & .000000E+00, .000000E+00, .000000E+00, .000000E+00, .000000E+00, | |
39378 | & .000000E+00, .000000E+00, .100000E+00, .500000E+01, .100000E+09/ | |
39379 | ||
39380 | IF(IPA.EQ.2212) THEN | |
39381 | ALA =PROP(1) | |
39382 | Q2MI = PROP(39) | |
39383 | Q2MA = PROP(40) | |
39384 | PDFNA = 'CKMT-PRO' | |
39385 | ELSE IF(IPA.EQ.990) THEN | |
39386 | ALA = POMP(1) | |
39387 | Q2MI = POMP(39) | |
39388 | Q2MA = POMP(40) | |
39389 | PDFNA = 'CKMT-POM' | |
39390 | ELSE | |
39391 | WRITE(LO,'(1X,A,I7)') | |
39392 | & 'PHO_CKMTPA:ERROR: invalid particle code',IPA | |
39393 | STOP | |
39394 | ENDIF | |
39395 | XMI = 1.D-4 | |
39396 | XMA = 1.D0 | |
39397 | END | |
39398 | ||
39399 | *$ CREATE PHO_CKMTPD.FOR | |
39400 | *COPY PHO_CKMTPD | |
39401 | CDECK ID>, PHO_CKMTPD | |
39402 | SUBROUTINE PHO_CKMTPD(IPAR,X,SCALE2,PD) | |
39403 | C********************************************************************** | |
39404 | C | |
39405 | C PDF based on Regge theory, evolved with .... by .... | |
39406 | C | |
39407 | C input: IPAR 2212 proton (not installed) | |
39408 | C 990 Pomeron | |
39409 | C | |
39410 | C output: PD(-6:6) x*f(x) parton distribution functions | |
39411 | C (PDFLIB convention: d = PD(1), u = PD(2) ) | |
39412 | C | |
39413 | C********************************************************************** | |
39414 | SAVE | |
39415 | ||
39416 | C input/output channels | |
39417 | INTEGER LI,LO | |
39418 | COMMON /POINOU/ LI,LO | |
39419 | ||
39420 | DOUBLE PRECISION X,SCALE2,PD(-6:6),CDN,CUP | |
39421 | DIMENSION QQ(7) | |
39422 | ||
39423 | Q2=SNGL(SCALE2) | |
39424 | Q1S=Q2 | |
39425 | XX=SNGL(X) | |
39426 | C QCD lambda for evolution | |
39427 | OWLAM = 0.23D0 | |
39428 | OWLAM2=OWLAM**2 | |
39429 | C Q0**2 for evolution | |
39430 | Q02 = 2.D0 | |
39431 | C | |
39432 | C | |
39433 | C the conventions are : q(1)=x*u, q(2)=x*d, q(3)=q(4)=x*sbar=x*ubar=... | |
39434 | C q(6)=x*charm, q(7)=x*gluon | |
39435 | C | |
39436 | SB=0. | |
39437 | IF(Q2-Q02) 1,1,2 | |
39438 | 2 SB=LOG(LOG(Q2/OWLAM2)/LOG(Q02/OWLAM2)) | |
39439 | 1 CONTINUE | |
39440 | IF(IPAR.EQ.2212) THEN | |
39441 | * CALL PHO_CKMTPR(XX,SB,QQ | |
39442 | WRITE(LO,'(/1X,A,I6)') 'PHO_CKMTPD:ERROR: invalid particle',IPAR | |
39443 | CALL PHO_ABORT | |
39444 | ELSE | |
39445 | CALL PHO_CKMTPO(XX,SB,QQ) | |
39446 | ENDIF | |
39447 | C | |
39448 | PD(-6) = 0.D0 | |
39449 | PD(-5) = 0.D0 | |
39450 | PD(-4) = DBLE(QQ(6)) | |
39451 | PD(-3) = DBLE(QQ(3)) | |
39452 | PD(-2) = DBLE(QQ(4)) | |
39453 | PD(-1) = DBLE(QQ(5)) | |
39454 | PD(0) = DBLE(QQ(7)) | |
39455 | PD(1) = DBLE(QQ(2)) | |
39456 | PD(2) = DBLE(QQ(1)) | |
39457 | PD(3) = DBLE(QQ(3)) | |
39458 | PD(4) = DBLE(QQ(6)) | |
39459 | PD(5) = 0.D0 | |
39460 | PD(6) = 0.D0 | |
39461 | IF(IPAR.EQ.990) THEN | |
39462 | CDN = (PD(1)-PD(-1))/2.D0 | |
39463 | CUP = (PD(2)-PD(-2))/2.D0 | |
39464 | PD(-1) = PD(-1) + CDN | |
39465 | PD(-2) = PD(-2) + CUP | |
39466 | PD(1) = PD(-1) | |
39467 | PD(2) = PD(-2) | |
39468 | ENDIF | |
39469 | END | |
39470 | ||
39471 | *$ CREATE PHO_CKMTPO.FOR | |
39472 | *COPY PHO_CKMTPO | |
39473 | CDECK ID>, PHO_CKMTPO | |
39474 | SUBROUTINE PHO_CKMTPO(X,S,QQ) | |
39475 | C********************************************************************** | |
39476 | C | |
39477 | C calculation partons in Pomeron | |
39478 | C | |
39479 | C********************************************************************** | |
39480 | SAVE | |
39481 | ||
39482 | DIMENSION QQ(7) | |
39483 | ||
39484 | C input/output channels | |
39485 | INTEGER LI,LO | |
39486 | COMMON /POINOU/ LI,LO | |
39487 | ||
39488 | DIMENSION F1(25),F2(25),GF(8,20,25),DL(4000) | |
39489 | EQUIVALENCE (GF(1,1,1),DL(1)) | |
39490 | DATA DELTA/.10/ | |
39491 | ||
39492 | C RNG= -.5 | |
39493 | C DEU.NORM. QUARKS,GLUONS,NEW NORM .6223E+00 .2754E+00 .1372E+01 | |
39494 | C POM.NORM. QUARKS,GLUONS,ALL .132E+00 .275E+00 .407E+00 | |
39495 | DATA (DL(K),K= 1, 85) / | |
39496 | & .324159E-01, .324159E-01, .298895E-01, .298895E-01, .298895E-01, | |
39497 | & .298895E-01, .486150E+00,-.867362E-18, .362035E-01, .362035E-01, | |
39498 | & .335142E-01, .335151E-01, .335151E-01, .335142E-01, .745381E+00, | |
39499 | & .399157E-02, .417146E-01, .417146E-01, .388545E-01, .388564E-01, | |
39500 | & .388564E-01, .388545E-01, .107588E+01, .969559E-02, .493208E-01, | |
39501 | & .493208E-01, .462819E-01, .462849E-01, .462849E-01, .462819E-01, | |
39502 | & .148168E+01, .174837E-01, .593251E-01, .593251E-01, .560991E-01, | |
39503 | & .561035E-01, .561035E-01, .560991E-01, .196422E+01, .276588E-01, | |
39504 | & .720220E-01, .720220E-01, .686007E-01, .686065E-01, .686065E-01, | |
39505 | & .686007E-01, .252331E+01, .405154E-01, .876695E-01, .876695E-01, | |
39506 | & .840445E-01, .840520E-01, .840520E-01, .840445E-01, .315730E+01, | |
39507 | & .563115E-01, .106489E+00, .106489E+00, .102652E+00, .102662E+00, | |
39508 | & .102662E+00, .102652E+00, .386313E+01, .752690E-01, .128662E+00, | |
39509 | & .128662E+00, .124605E+00, .124616E+00, .124616E+00, .124605E+00, | |
39510 | & .463661E+01, .975686E-01, .154326E+00, .154326E+00, .150039E+00, | |
39511 | & .150053E+00, .150053E+00, .150039E+00, .547247E+01, .123348E+00, | |
39512 | & .183571E+00, .183571E+00, .179048E+00, .179063E+00, .179063E+00/ | |
39513 | DATA (DL(K),K= 86, 170) / | |
39514 | & .179048E+00, .636464E+01, .152698E+00, .216445E+00, .216445E+00, | |
39515 | & .211676E+00, .211694E+00, .211694E+00, .211676E+00, .730631E+01, | |
39516 | & .185666E+00, .252948E+00, .252948E+00, .247925E+00, .247946E+00, | |
39517 | & .247946E+00, .247925E+00, .829017E+01, .222252E+00, .293037E+00, | |
39518 | & .293037E+00, .287752E+00, .287776E+00, .287776E+00, .287752E+00, | |
39519 | & .930850E+01, .262414E+00, .336625E+00, .336625E+00, .331070E+00, | |
39520 | & .331097E+00, .331097E+00, .331070E+00, .103534E+02, .306065E+00, | |
39521 | & .383587E+00, .383587E+00, .377754E+00, .377785E+00, .377785E+00, | |
39522 | & .377754E+00, .114166E+02, .353079E+00, .433760E+00, .433760E+00, | |
39523 | & .427641E+00, .427675E+00, .427675E+00, .427641E+00, .124903E+02, | |
39524 | & .403294E+00, .000000E+00, .000000E+00, .000000E+00, .000000E+00, | |
39525 | & .000000E+00, .000000E+00, .000000E+00, .000000E+00, .000000E+00, | |
39526 | & .000000E+00, .000000E+00, .000000E+00, .000000E+00, .000000E+00, | |
39527 | & .000000E+00, .000000E+00, .000000E+00, .000000E+00, .000000E+00, | |
39528 | & .000000E+00, .000000E+00, .000000E+00, .000000E+00, .000000E+00, | |
39529 | & .296507E-01, .296507E-01, .258624E-01, .258624E-01, .258624E-01, | |
39530 | & .258624E-01, .422709E+00,-.173472E-17, .330029E-01, .330029E-01/ | |
39531 | DATA (DL(K),K= 171, 255) / | |
39532 | & .289773E-01, .289787E-01, .289787E-01, .289773E-01, .642996E+00, | |
39533 | & .344499E-02, .377610E-01, .377610E-01, .334880E-01, .334910E-01, | |
39534 | & .334910E-01, .334880E-01, .914159E+00, .828363E-02, .441590E-01, | |
39535 | & .441590E-01, .396285E-01, .396333E-01, .396333E-01, .396285E-01, | |
39536 | & .123635E+01, .147501E-01, .523710E-01, .523710E-01, .475730E-01, | |
39537 | & .475798E-01, .475798E-01, .475730E-01, .160820E+01, .230185E-01, | |
39538 | & .625514E-01, .625514E-01, .574758E-01, .574848E-01, .574848E-01, | |
39539 | & .574758E-01, .202705E+01, .332433E-01, .748195E-01, .748195E-01, | |
39540 | & .694563E-01, .694678E-01, .694678E-01, .694563E-01, .248945E+01, | |
39541 | & .455440E-01, .892611E-01, .892611E-01, .836006E-01, .836147E-01, | |
39542 | & .836147E-01, .836006E-01, .299114E+01, .600067E-01, .105928E+00, | |
39543 | & .105928E+00, .999607E-01, .999776E-01, .999776E-01, .999607E-01, | |
39544 | & .352735E+01, .766833E-01, .124839E+00, .124839E+00, .118555E+00, | |
39545 | & .118575E+00, .118575E+00, .118555E+00, .409288E+01, .955921E-01, | |
39546 | & .145978E+00, .145978E+00, .139368E+00, .139391E+00, .139391E+00, | |
39547 | & .139368E+00, .468226E+01, .116719E+00, .169300E+00, .169300E+00, | |
39548 | & .162355E+00, .162382E+00, .162382E+00, .162355E+00, .528987E+01/ | |
39549 | DATA (DL(K),K= 256, 340) / | |
39550 | & .140017E+00, .194730E+00, .194730E+00, .187441E+00, .187471E+00, | |
39551 | & .187471E+00, .187441E+00, .591007E+01, .165413E+00, .222167E+00, | |
39552 | & .222167E+00, .214525E+00, .214559E+00, .214559E+00, .214525E+00, | |
39553 | & .653724E+01, .192806E+00, .251486E+00, .251486E+00, .243482E+00, | |
39554 | & .243521E+00, .243521E+00, .243482E+00, .716591E+01, .222070E+00, | |
39555 | & .282539E+00, .282539E+00, .274165E+00, .274208E+00, .274208E+00, | |
39556 | & .274165E+00, .779082E+01, .253058E+00, .315161E+00, .315161E+00, | |
39557 | & .306410E+00, .306458E+00, .306458E+00, .306410E+00, .840695E+01, | |
39558 | & .285608E+00, .000000E+00, .000000E+00, .000000E+00, .000000E+00, | |
39559 | & .000000E+00, .000000E+00, .000000E+00, .000000E+00, .000000E+00, | |
39560 | & .000000E+00, .000000E+00, .000000E+00, .000000E+00, .000000E+00, | |
39561 | & .000000E+00, .000000E+00, .000000E+00, .000000E+00, .000000E+00, | |
39562 | & .000000E+00, .000000E+00, .000000E+00, .000000E+00, .000000E+00, | |
39563 | & .279581E-01, .279581E-01, .222797E-01, .222797E-01, .222797E-01, | |
39564 | & .222797E-01, .367732E+00, .867362E-18, .309604E-01, .309604E-01, | |
39565 | & .249419E-01, .249441E-01, .249441E-01, .249419E-01, .552053E+00, | |
39566 | & .296633E-02, .350831E-01, .350831E-01, .287126E-01, .287173E-01/ | |
39567 | DATA (DL(K),K= 341, 425) / | |
39568 | & .287173E-01, .287126E-01, .770476E+00, .704001E-02, .404554E-01, | |
39569 | & .404554E-01, .337212E-01, .337286E-01, .337286E-01, .337212E-01, | |
39570 | & .102096E+01, .123504E-01, .471588E-01, .471588E-01, .400495E-01, | |
39571 | & .400599E-01, .400599E-01, .400495E-01, .130079E+01, .189795E-01, | |
39572 | & .552518E-01, .552518E-01, .477564E-01, .477700E-01, .477700E-01, | |
39573 | & .477564E-01, .160637E+01, .269860E-01, .647649E-01, .647649E-01, | |
39574 | & .568725E-01, .568897E-01, .568897E-01, .568725E-01, .193388E+01, | |
39575 | & .364007E-01, .757021E-01, .757021E-01, .674022E-01, .674232E-01, | |
39576 | & .674232E-01, .674022E-01, .227916E+01, .472280E-01, .880430E-01, | |
39577 | & .880430E-01, .793257E-01, .793507E-01, .793507E-01, .793257E-01, | |
39578 | & .263802E+01, .594481E-01, .101745E+00, .101745E+00, .926005E-01, | |
39579 | & .926297E-01, .926297E-01, .926005E-01, .300628E+01, .730184E-01, | |
39580 | & .116745E+00, .116745E+00, .107164E+00, .107198E+00, .107198E+00, | |
39581 | & .107164E+00, .337982E+01, .878765E-01, .132961E+00, .132961E+00, | |
39582 | & .122936E+00, .122974E+00, .122974E+00, .122936E+00, .375469E+01, | |
39583 | & .103942E+00, .150298E+00, .150298E+00, .139820E+00, .139863E+00, | |
39584 | & .139863E+00, .139820E+00, .412714E+01, .121118E+00, .168645E+00/ | |
39585 | DATA (DL(K),K= 426, 510) / | |
39586 | & .168645E+00, .157706E+00, .157754E+00, .157754E+00, .157706E+00, | |
39587 | & .449366E+01, .139296E+00, .187883E+00, .187883E+00, .176476E+00, | |
39588 | & .176529E+00, .176529E+00, .176476E+00, .485100E+01, .158356E+00, | |
39589 | & .207882E+00, .207882E+00, .196000E+00, .196059E+00, .196059E+00, | |
39590 | & .196000E+00, .519622E+01, .178170E+00, .228506E+00, .228506E+00, | |
39591 | & .216145E+00, .216209E+00, .216209E+00, .216145E+00, .552665E+01, | |
39592 | & .198603E+00, .000000E+00, .000000E+00, .000000E+00, .000000E+00, | |
39593 | & .000000E+00, .000000E+00, .000000E+00, .000000E+00, .000000E+00, | |
39594 | & .000000E+00, .000000E+00, .000000E+00, .000000E+00, .000000E+00, | |
39595 | & .000000E+00, .000000E+00, .000000E+00, .000000E+00, .000000E+00, | |
39596 | & .000000E+00, .000000E+00, .000000E+00, .000000E+00, .000000E+00, | |
39597 | & .275294E-01, .275294E-01, .190245E-01, .190245E-01, .190245E-01, | |
39598 | & .190245E-01, .320228E+00, .000000E+00, .302671E-01, .302671E-01, | |
39599 | & .212851E-01, .212884E-01, .212884E-01, .212851E-01, .470861E+00, | |
39600 | & .255059E-02, .338703E-01, .338703E-01, .243988E-01, .244059E-01, | |
39601 | & .244059E-01, .243988E-01, .642452E+00, .595399E-02, .383922E-01, | |
39602 | & .383922E-01, .284195E-01, .284305E-01, .284305E-01, .284195E-01/ | |
39603 | DATA (DL(K),K= 511, 595) / | |
39604 | & .831913E+00, .102638E-01, .438519E-01, .438519E-01, .333669E-01, | |
39605 | & .333821E-01, .333821E-01, .333669E-01, .103618E+01, .155000E-01, | |
39606 | & .502475E-01, .502475E-01, .392399E-01, .392595E-01, .392595E-01, | |
39607 | & .392399E-01, .125172E+01, .216612E-01, .575580E-01, .575580E-01, | |
39608 | & .460181E-01, .460425E-01, .460425E-01, .460181E-01, .147519E+01, | |
39609 | & .287272E-01, .657445E-01, .657445E-01, .536635E-01, .536929E-01, | |
39610 | & .536929E-01, .536635E-01, .170330E+01, .366597E-01, .747539E-01, | |
39611 | & .747539E-01, .621238E-01, .621582E-01, .621582E-01, .621238E-01, | |
39612 | & .193297E+01, .454066E-01, .845205E-01, .845205E-01, .713340E-01, | |
39613 | & .713738E-01, .713738E-01, .713340E-01, .216133E+01, .549027E-01, | |
39614 | & .949687E-01, .949687E-01, .812194E-01, .812646E-01, .812646E-01, | |
39615 | & .812194E-01, .238578E+01, .650733E-01, .106015E+00, .106015E+00, | |
39616 | & .916972E-01, .917480E-01, .917480E-01, .916972E-01, .260395E+01, | |
39617 | & .758355E-01, .117569E+00, .117569E+00, .102678E+00, .102735E+00, | |
39618 | & .102735E+00, .102678E+00, .281373E+01, .871004E-01, .129537E+00, | |
39619 | & .129537E+00, .114070E+00, .114133E+00, .114133E+00, .114070E+00, | |
39620 | & .301327E+01, .987750E-01, .141824E+00, .141824E+00, .125777E+00/ | |
39621 | DATA (DL(K),K= 596, 680) / | |
39622 | & .125846E+00, .125846E+00, .125777E+00, .320098E+01, .110764E+00, | |
39623 | & .154331E+00, .154331E+00, .137703E+00, .137778E+00, .137778E+00, | |
39624 | & .137703E+00, .337553E+01, .122970E+00, .166962E+00, .166962E+00, | |
39625 | & .149753E+00, .149833E+00, .149833E+00, .149753E+00, .353582E+01, | |
39626 | & .135299E+00, .000000E+00, .000000E+00, .000000E+00, .000000E+00, | |
39627 | & .000000E+00, .000000E+00, .000000E+00, .000000E+00, .000000E+00, | |
39628 | & .000000E+00, .000000E+00, .000000E+00, .000000E+00, .000000E+00, | |
39629 | & .000000E+00, .000000E+00, .000000E+00, .000000E+00, .000000E+00, | |
39630 | & .000000E+00, .000000E+00, .000000E+00, .000000E+00, .000000E+00, | |
39631 | & .286766E-01, .286766E-01, .159579E-01, .159579E-01, .159579E-01, | |
39632 | & .159579E-01, .279430E+00,-.867362E-18, .312327E-01, .312327E-01, | |
39633 | & .178644E-01, .178691E-01, .178691E-01, .178644E-01, .399186E+00, | |
39634 | & .219459E-02, .344289E-01, .344289E-01, .204015E-01, .204111E-01, | |
39635 | & .204111E-01, .204015E-01, .529978E+00, .501953E-02, .382657E-01, | |
39636 | & .382657E-01, .235713E-01, .235860E-01, .235860E-01, .235713E-01, | |
39637 | & .668515E+00, .847682E-02, .427243E-01, .427243E-01, .273559E-01, | |
39638 | & .273758E-01, .273758E-01, .273559E-01, .812075E+00, .125486E-01/ | |
39639 | DATA (DL(K),K= 681, 765) / | |
39640 | & .477691E-01, .477691E-01, .317212E-01, .317465E-01, .317465E-01, | |
39641 | & .317212E-01, .957801E+00, .172006E-01, .533547E-01, .533547E-01, | |
39642 | & .366231E-01, .366539E-01, .366539E-01, .366231E-01, .110327E+01, | |
39643 | & .223886E-01, .594259E-01, .594259E-01, .420076E-01, .420441E-01, | |
39644 | & .420441E-01, .420076E-01, .124628E+01, .280584E-01, .659213E-01, | |
39645 | & .659213E-01, .478149E-01, .478570E-01, .478570E-01, .478149E-01, | |
39646 | & .138496E+01, .341502E-01, .727749E-01, .727749E-01, .539803E-01, | |
39647 | & .540280E-01, .540280E-01, .539803E-01, .151767E+01, .405990E-01, | |
39648 | & .799178E-01, .799178E-01, .604361E-01, .604895E-01, .604895E-01, | |
39649 | & .604361E-01, .164304E+01, .473372E-01, .872796E-01, .872796E-01, | |
39650 | & .671134E-01, .671724E-01, .671724E-01, .671134E-01, .175992E+01, | |
39651 | & .542955E-01, .947896E-01, .947896E-01, .739429E-01, .740075E-01, | |
39652 | & .740075E-01, .739429E-01, .186739E+01, .614047E-01, .102378E+00, | |
39653 | & .102378E+00, .808565E-01, .809266E-01, .809266E-01, .808565E-01, | |
39654 | & .196473E+01, .685965E-01, .109978E+00, .109978E+00, .877881E-01, | |
39655 | & .878637E-01, .878637E-01, .877881E-01, .205141E+01, .758045E-01, | |
39656 | & .117525E+00, .117525E+00, .946745E-01, .947553E-01, .947553E-01/ | |
39657 | DATA (DL(K),K= 766, 850) / | |
39658 | & .946745E-01, .212709E+01, .829655E-01, .124958E+00, .124958E+00, | |
39659 | & .101456E+00, .101542E+00, .101542E+00, .101456E+00, .219159E+01, | |
39660 | & .900196E-01, .000000E+00, .000000E+00, .000000E+00, .000000E+00, | |
39661 | & .000000E+00, .000000E+00, .000000E+00, .000000E+00, .000000E+00, | |
39662 | & .000000E+00, .000000E+00, .000000E+00, .000000E+00, .000000E+00, | |
39663 | & .000000E+00, .000000E+00, .000000E+00, .000000E+00, .000000E+00, | |
39664 | & .000000E+00, .000000E+00, .000000E+00, .000000E+00, .000000E+00, | |
39665 | & .318691E-01, .318691E-01, .129081E-01, .129081E-01, .129081E-01, | |
39666 | & .129081E-01, .244842E+00,-.867362E-18, .343104E-01, .343104E-01, | |
39667 | & .145076E-01, .145124E-01, .145124E-01, .145076E-01, .337040E+00, | |
39668 | & .189443E-02, .371900E-01, .371900E-01, .165461E-01, .165557E-01, | |
39669 | & .165557E-01, .165461E-01, .433081E+00, .422691E-02, .404763E-01, | |
39670 | & .404763E-01, .189941E-01, .190085E-01, .190085E-01, .189941E-01, | |
39671 | & .530109E+00, .696769E-02, .441304E-01, .441304E-01, .218150E-01, | |
39672 | & .218342E-01, .218342E-01, .218150E-01, .626129E+00, .100799E-01, | |
39673 | & .481031E-01, .481031E-01, .249615E-01, .249853E-01, .249853E-01, | |
39674 | & .249615E-01, .719221E+00, .135159E-01, .523426E-01, .523426E-01/ | |
39675 | DATA (DL(K),K= 851, 935) / | |
39676 | & .283837E-01, .284122E-01, .284122E-01, .283837E-01, .807951E+00, | |
39677 | & .172259E-01, .567940E-01, .567940E-01, .320288E-01, .320619E-01, | |
39678 | & .320619E-01, .320288E-01, .891154E+00, .211568E-01, .614022E-01, | |
39679 | & .614022E-01, .358436E-01, .358811E-01, .358811E-01, .358436E-01, | |
39680 | & .967928E+00, .252549E-01, .661122E-01, .661122E-01, .397750E-01, | |
39681 | & .398169E-01, .398169E-01, .397750E-01, .103759E+01, .294673E-01, | |
39682 | & .708708E-01, .708708E-01, .437716E-01, .438176E-01, .438176E-01, | |
39683 | & .437716E-01, .109966E+01, .337422E-01, .756269E-01, .756269E-01, | |
39684 | & .477840E-01, .478342E-01, .478342E-01, .477840E-01, .115380E+01, | |
39685 | & .380302E-01, .803322E-01, .803322E-01, .517659E-01, .518200E-01, | |
39686 | & .518200E-01, .517659E-01, .119986E+01, .422846E-01, .849423E-01, | |
39687 | & .849423E-01, .556743E-01, .557322E-01, .557322E-01, .556743E-01, | |
39688 | & .123782E+01, .464624E-01, .894164E-01, .894164E-01, .594701E-01, | |
39689 | & .595315E-01, .595315E-01, .594701E-01, .126777E+01, .505242E-01, | |
39690 | & .937178E-01, .937178E-01, .631181E-01, .631829E-01, .631829E-01, | |
39691 | & .631181E-01, .128993E+01, .544348E-01, .978144E-01, .978144E-01, | |
39692 | & .665876E-01, .666556E-01, .666556E-01, .665876E-01, .130457E+01/ | |
39693 | DATA (DL(K),K= 936, 1020) / | |
39694 | & .581632E-01, .000000E+00, .000000E+00, .000000E+00, .000000E+00, | |
39695 | & .000000E+00, .000000E+00, .000000E+00, .000000E+00, .000000E+00, | |
39696 | & .000000E+00, .000000E+00, .000000E+00, .000000E+00, .000000E+00, | |
39697 | & .000000E+00, .000000E+00, .000000E+00, .000000E+00, .000000E+00, | |
39698 | & .000000E+00, .000000E+00, .000000E+00, .000000E+00, .000000E+00, | |
39699 | & .377668E-01, .377668E-01, .968304E-02, .968304E-02, .968304E-02, | |
39700 | & .968304E-02, .216392E+00,-.130104E-17, .401066E-01, .401066E-01, | |
39701 | & .110266E-01, .110291E-01, .110291E-01, .110266E-01, .284113E+00, | |
39702 | & .164283E-02, .426983E-01, .426983E-01, .126461E-01, .126510E-01, | |
39703 | & .126510E-01, .126461E-01, .350879E+00, .355790E-02, .454940E-01, | |
39704 | & .454940E-01, .144965E-01, .145039E-01, .145039E-01, .144965E-01, | |
39705 | & .414611E+00, .570002E-02, .484493E-01, .484493E-01, .165364E-01, | |
39706 | & .165462E-01, .165462E-01, .165364E-01, .474149E+00, .802739E-02, | |
39707 | & .515153E-01, .515153E-01, .187191E-01, .187313E-01, .187313E-01, | |
39708 | & .187191E-01, .528511E+00, .104932E-01, .546458E-01, .546458E-01, | |
39709 | & .210009E-01, .210154E-01, .210154E-01, .210009E-01, .577107E+00, | |
39710 | & .130535E-01, .577962E-01, .577962E-01, .233395E-01, .233563E-01/ | |
39711 | DATA (DL(K),K= 1021, 1105) / | |
39712 | & .233563E-01, .233395E-01, .619574E+00, .156658E-01, .609249E-01, | |
39713 | & .609249E-01, .256954E-01, .257143E-01, .257143E-01, .256954E-01, | |
39714 | & .655725E+00, .182905E-01, .639938E-01, .639938E-01, .280322E-01, | |
39715 | & .280532E-01, .280532E-01, .280322E-01, .685523E+00, .208909E-01, | |
39716 | & .669681E-01, .669681E-01, .303170E-01, .303399E-01, .303399E-01, | |
39717 | & .303170E-01, .709053E+00, .234341E-01, .698172E-01, .698172E-01, | |
39718 | & .325206E-01, .325454E-01, .325454E-01, .325206E-01, .726501E+00, | |
39719 | & .258907E-01, .725141E-01, .725141E-01, .346176E-01, .346442E-01, | |
39720 | & .346442E-01, .346176E-01, .738139E+00, .282352E-01, .750364E-01, | |
39721 | & .750364E-01, .365866E-01, .366148E-01, .366148E-01, .365866E-01, | |
39722 | & .744304E+00, .304461E-01, .773653E-01, .773653E-01, .384099E-01, | |
39723 | & .384396E-01, .384396E-01, .384099E-01, .745388E+00, .325056E-01, | |
39724 | & .794860E-01, .794860E-01, .400736E-01, .401046E-01, .401046E-01, | |
39725 | & .400736E-01, .741819E+00, .343996E-01, .813873E-01, .813873E-01, | |
39726 | & .415670E-01, .415993E-01, .415993E-01, .415670E-01, .734051E+00, | |
39727 | & .361177E-01, .000000E+00, .000000E+00, .000000E+00, .000000E+00, | |
39728 | & .000000E+00, .000000E+00, .000000E+00, .000000E+00, .000000E+00/ | |
39729 | DATA (DL(K),K= 1106, 1190) / | |
39730 | & .000000E+00, .000000E+00, .000000E+00, .000000E+00, .000000E+00, | |
39731 | & .000000E+00, .000000E+00, .000000E+00, .000000E+00, .000000E+00, | |
39732 | & .000000E+00, .000000E+00, .000000E+00, .000000E+00, .000000E+00, | |
39733 | & .433773E-01, .433773E-01, .745094E-02, .745094E-02, .745094E-02, | |
39734 | & .745094E-02, .201612E+00,-.130104E-17, .455998E-01, .455998E-01, | |
39735 | & .866239E-02, .866443E-02, .866443E-02, .866239E-02, .255046E+00, | |
39736 | & .149977E-02, .479569E-01, .479569E-01, .100584E-01, .100624E-01, | |
39737 | & .100624E-01, .100584E-01, .305549E+00, .317779E-02, .503976E-01, | |
39738 | & .503976E-01, .115911E-01, .115970E-01, .115970E-01, .115911E-01, | |
39739 | & .351606E+00, .498612E-02, .528804E-01, .528804E-01, .132216E-01, | |
39740 | & .132293E-01, .132293E-01, .132216E-01, .392560E+00, .688553E-02, | |
39741 | & .553621E-01, .553621E-01, .149087E-01, .149181E-01, .149181E-01, | |
39742 | & .149087E-01, .427948E+00, .883486E-02, .578049E-01, .578049E-01, | |
39743 | & .166165E-01, .166276E-01, .166276E-01, .166165E-01, .457612E+00, | |
39744 | & .107980E-01, .601739E-01, .601739E-01, .183120E-01, .183246E-01, | |
39745 | & .183246E-01, .183120E-01, .481565E+00, .127419E-01, .624390E-01, | |
39746 | & .624390E-01, .199661E-01, .199801E-01, .199801E-01, .199661E-01/ | |
39747 | DATA (DL(K),K= 1191, 1275) / | |
39748 | & .499943E+00, .146375E-01, .645736E-01, .645736E-01, .215535E-01, | |
39749 | & .215688E-01, .215688E-01, .215535E-01, .512983E+00, .164593E-01, | |
39750 | & .665556E-01, .665556E-01, .230528E-01, .230693E-01, .230693E-01, | |
39751 | & .230528E-01, .520995E+00, .181859E-01, .683669E-01, .683669E-01, | |
39752 | & .244463E-01, .244639E-01, .244639E-01, .244463E-01, .524347E+00, | |
39753 | & .197998E-01, .699932E-01, .699932E-01, .257201E-01, .257387E-01, | |
39754 | & .257387E-01, .257201E-01, .523447E+00, .212869E-01, .714240E-01, | |
39755 | & .714240E-01, .268637E-01, .268832E-01, .268832E-01, .268637E-01, | |
39756 | & .518729E+00, .226367E-01, .726523E-01, .726523E-01, .278697E-01, | |
39757 | & .278900E-01, .278900E-01, .278697E-01, .510641E+00, .238420E-01, | |
39758 | & .736741E-01, .736741E-01, .287338E-01, .287547E-01, .287547E-01, | |
39759 | & .287338E-01, .499630E+00, .248984E-01, .744886E-01, .744886E-01, | |
39760 | & .294542E-01, .294757E-01, .294757E-01, .294542E-01, .486140E+00, | |
39761 | & .258043E-01, .000000E+00, .000000E+00, .000000E+00, .000000E+00, | |
39762 | & .000000E+00, .000000E+00, .000000E+00, .000000E+00, .000000E+00, | |
39763 | & .000000E+00, .000000E+00, .000000E+00, .000000E+00, .000000E+00, | |
39764 | & .000000E+00, .000000E+00, .000000E+00, .000000E+00, .000000E+00/ | |
39765 | DATA (DL(K),K= 1276, 1360) / | |
39766 | & .000000E+00, .000000E+00, .000000E+00, .000000E+00, .000000E+00, | |
39767 | & .499162E-01, .499162E-01, .534441E-02, .534441E-02, .534441E-02, | |
39768 | & .534441E-02, .191108E+00,-.151788E-17, .519197E-01, .519197E-01, | |
39769 | & .646285E-02, .646402E-02, .646402E-02, .646285E-02, .232539E+00, | |
39770 | & .137669E-02, .539504E-01, .539504E-01, .769150E-02, .769377E-02, | |
39771 | & .769377E-02, .769150E-02, .269907E+00, .285489E-02, .559598E-01, | |
39772 | & .559598E-01, .898389E-02, .898721E-02, .898721E-02, .898389E-02, | |
39773 | & .302186E+00, .438814E-02, .579130E-01, .579130E-01, .103061E-01, | |
39774 | & .103104E-01, .103104E-01, .103061E-01, .329124E+00, .594258E-02, | |
39775 | & .597754E-01, .597754E-01, .116245E-01, .116297E-01, .116297E-01, | |
39776 | & .116245E-01, .350643E+00, .748452E-02, .615191E-01, .615191E-01, | |
39777 | & .129113E-01, .129174E-01, .129174E-01, .129113E-01, .366890E+00, | |
39778 | & .898645E-02, .631204E-01, .631204E-01, .141428E-01, .141497E-01, | |
39779 | & .141497E-01, .141428E-01, .378134E+00, .104247E-01, .645601E-01, | |
39780 | & .645601E-01, .152995E-01, .153071E-01, .153071E-01, .152995E-01, | |
39781 | & .384719E+00, .117798E-01, .658236E-01, .658236E-01, .163657E-01, | |
39782 | & .163739E-01, .163739E-01, .163657E-01, .387045E+00, .130362E-01/ | |
39783 | DATA (DL(K),K= 1361, 1445) / | |
39784 | & .669000E-01, .669000E-01, .173294E-01, .173381E-01, .173381E-01, | |
39785 | & .173294E-01, .385547E+00, .141821E-01, .677824E-01, .677824E-01, | |
39786 | & .181820E-01, .181912E-01, .181912E-01, .181820E-01, .380677E+00, | |
39787 | & .152091E-01, .684672E-01, .684672E-01, .189180E-01, .189277E-01, | |
39788 | & .189277E-01, .189180E-01, .372894E+00, .161119E-01, .689539E-01, | |
39789 | & .689539E-01, .195349E-01, .195449E-01, .195449E-01, .195349E-01, | |
39790 | & .362650E+00, .168880E-01, .692447E-01, .692447E-01, .200324E-01, | |
39791 | & .200427E-01, .200427E-01, .200324E-01, .350383E+00, .175374E-01, | |
39792 | & .693442E-01, .693442E-01, .204123E-01, .204229E-01, .204229E-01, | |
39793 | & .204123E-01, .336505E+00, .180622E-01, .692590E-01, .692590E-01, | |
39794 | & .206783E-01, .206891E-01, .206891E-01, .206783E-01, .321403E+00, | |
39795 | & .184661E-01, .000000E+00, .000000E+00, .000000E+00, .000000E+00, | |
39796 | & .000000E+00, .000000E+00, .000000E+00, .000000E+00, .000000E+00, | |
39797 | & .000000E+00, .000000E+00, .000000E+00, .000000E+00, .000000E+00, | |
39798 | & .000000E+00, .000000E+00, .000000E+00, .000000E+00, .000000E+00, | |
39799 | & .000000E+00, .000000E+00, .000000E+00, .000000E+00, .000000E+00, | |
39800 | & .554152E-01, .554152E-01, .386683E-02, .386683E-02, .386683E-02/ | |
39801 | DATA (DL(K),K= 1446, 1530) / | |
39802 | & .386683E-02, .185844E+00,-.151788E-17, .571372E-01, .571372E-01, | |
39803 | & .493623E-02, .493704E-02, .493704E-02, .493623E-02, .219342E+00, | |
39804 | & .129037E-02, .588098E-01, .588098E-01, .606768E-02, .606924E-02, | |
39805 | & .606924E-02, .606768E-02, .248288E+00, .263296E-02, .603896E-01, | |
39806 | & .603896E-01, .721747E-02, .721973E-02, .721973E-02, .721747E-02, | |
39807 | & .271974E+00, .398431E-02, .618484E-01, .618484E-01, .835658E-02, | |
39808 | & .835949E-02, .835949E-02, .835658E-02, .290397E+00, .531560E-02, | |
39809 | & .631600E-01, .631600E-01, .945726E-02, .946074E-02, .946074E-02, | |
39810 | & .945726E-02, .303702E+00, .659930E-02, .643051E-01, .643051E-01, | |
39811 | & .104983E-01, .105023E-01, .105023E-01, .104983E-01, .312209E+00, | |
39812 | & .781443E-02, .652691E-01, .652691E-01, .114624E-01, .114669E-01, | |
39813 | & .114669E-01, .114624E-01, .316328E+00, .894407E-02, .660416E-01, | |
39814 | & .660416E-01, .123367E-01, .123416E-01, .123416E-01, .123367E-01, | |
39815 | & .316509E+00, .997546E-02, .666169E-01, .666169E-01, .131119E-01, | |
39816 | & .131171E-01, .131171E-01, .131119E-01, .313229E+00, .108996E-01, | |
39817 | & .669925E-01, .669925E-01, .137818E-01, .137874E-01, .137874E-01, | |
39818 | & .137818E-01, .306974E+00, .117107E-01, .671695E-01, .671695E-01/ | |
39819 | DATA (DL(K),K= 1531, 1615) / | |
39820 | & .143437E-01, .143495E-01, .143495E-01, .143437E-01, .298224E+00, | |
39821 | & .124061E-01, .671517E-01, .671517E-01, .147970E-01, .148031E-01, | |
39822 | & .148031E-01, .147970E-01, .287441E+00, .129858E-01, .669454E-01, | |
39823 | & .669454E-01, .151437E-01, .151499E-01, .151499E-01, .151437E-01, | |
39824 | & .275064E+00, .134517E-01, .665590E-01, .665590E-01, .153872E-01, | |
39825 | & .153935E-01, .153935E-01, .153872E-01, .261497E+00, .138078E-01, | |
39826 | & .660023E-01, .660023E-01, .155327E-01, .155391E-01, .155391E-01, | |
39827 | & .155327E-01, .247105E+00, .140595E-01, .652865E-01, .652865E-01, | |
39828 | & .155864E-01, .155929E-01, .155929E-01, .155864E-01, .232218E+00, | |
39829 | & .142131E-01, .000000E+00, .000000E+00, .000000E+00, .000000E+00, | |
39830 | & .000000E+00, .000000E+00, .000000E+00, .000000E+00, .000000E+00, | |
39831 | & .000000E+00, .000000E+00, .000000E+00, .000000E+00, .000000E+00, | |
39832 | & .000000E+00, .000000E+00, .000000E+00, .000000E+00, .000000E+00, | |
39833 | & .000000E+00, .000000E+00, .000000E+00, .000000E+00, .000000E+00, | |
39834 | & .601098E-01, .601098E-01, .278641E-02, .278641E-02, .278641E-02, | |
39835 | & .278641E-02, .183460E+00, .130104E-17, .614949E-01, .614949E-01, | |
39836 | & .382710E-02, .382771E-02, .382771E-02, .382710E-02, .211150E+00/ | |
39837 | DATA (DL(K),K= 1616, 1700) / | |
39838 | & .122320E-02, .627722E-01, .627722E-01, .489465E-02, .489580E-02, | |
39839 | & .489580E-02, .489465E-02, .234040E+00, .246333E-02, .639042E-01, | |
39840 | & .639042E-01, .594825E-02, .594990E-02, .594990E-02, .594825E-02, | |
39841 | & .251649E+00, .367998E-02, .648697E-01, .648697E-01, .696315E-02, | |
39842 | & .696526E-02, .696526E-02, .696315E-02, .264143E+00, .484875E-02, | |
39843 | & .656502E-01, .656502E-01, .791658E-02, .791907E-02, .791907E-02, | |
39844 | & .791658E-02, .271822E+00, .594722E-02, .662343E-01, .662343E-01, | |
39845 | & .879236E-02, .879520E-02, .879520E-02, .879236E-02, .275124E+00, | |
39846 | & .695957E-02, .666152E-01, .666152E-01, .957846E-02, .958160E-02, | |
39847 | & .958160E-02, .957846E-02, .274549E+00, .787413E-02, .667905E-01, | |
39848 | & .667905E-01, .102668E-01, .102702E-01, .102702E-01, .102668E-01, | |
39849 | & .270615E+00, .868318E-02, .667616E-01, .667616E-01, .108528E-01, | |
39850 | & .108564E-01, .108564E-01, .108528E-01, .263847E+00, .938250E-02, | |
39851 | & .665331E-01, .665331E-01, .113349E-01, .113387E-01, .113387E-01, | |
39852 | & .113349E-01, .254756E+00, .997082E-02, .661123E-01, .661123E-01, | |
39853 | & .117139E-01, .117179E-01, .117179E-01, .117139E-01, .243828E+00, | |
39854 | & .104494E-01, .655090E-01, .655090E-01, .119931E-01, .119971E-01/ | |
39855 | DATA (DL(K),K= 1701, 1785) / | |
39856 | & .119971E-01, .119931E-01, .231518E+00, .108217E-01, .647345E-01, | |
39857 | & .647345E-01, .121770E-01, .121811E-01, .121811E-01, .121770E-01, | |
39858 | & .218237E+00, .110927E-01, .638017E-01, .638017E-01, .122717E-01, | |
39859 | & .122759E-01, .122759E-01, .122717E-01, .204353E+00, .112689E-01, | |
39860 | & .627241E-01, .627241E-01, .122842E-01, .122884E-01, .122884E-01, | |
39861 | & .122842E-01, .190187E+00, .113573E-01, .615161E-01, .615161E-01, | |
39862 | & .122221E-01, .122262E-01, .122262E-01, .122221E-01, .176012E+00, | |
39863 | & .113659E-01, .000000E+00, .000000E+00, .000000E+00, .000000E+00, | |
39864 | & .000000E+00, .000000E+00, .000000E+00, .000000E+00, .000000E+00, | |
39865 | & .000000E+00, .000000E+00, .000000E+00, .000000E+00, .000000E+00, | |
39866 | & .000000E+00, .000000E+00, .000000E+00, .000000E+00, .000000E+00, | |
39867 | & .000000E+00, .000000E+00, .000000E+00, .000000E+00, .000000E+00, | |
39868 | & .641221E-01, .641221E-01, .198544E-02, .198544E-02, .198544E-02, | |
39869 | & .198544E-02, .183018E+00, .184314E-17, .651208E-01, .651208E-01, | |
39870 | & .300778E-02, .300823E-02, .300823E-02, .300778E-02, .206180E+00, | |
39871 | & .116844E-02, .659664E-01, .659664E-01, .402903E-02, .402989E-02, | |
39872 | & .402989E-02, .402903E-02, .224390E+00, .232648E-02, .666277E-01/ | |
39873 | DATA (DL(K),K= 1786, 1870) / | |
39874 | & .666277E-01, .501117E-02, .501238E-02, .501238E-02, .501117E-02, | |
39875 | & .237332E+00, .343657E-02, .670904E-01, .670904E-01, .593321E-02, | |
39876 | & .593473E-02, .593473E-02, .593321E-02, .245310E+00, .447818E-02, | |
39877 | & .673435E-01, .673435E-01, .677663E-02, .677843E-02, .677843E-02, | |
39878 | & .677663E-02, .248743E+00, .543320E-02, .673832E-01, .673832E-01, | |
39879 | & .752958E-02, .753161E-02, .753161E-02, .752958E-02, .248162E+00, | |
39880 | & .629021E-02, .672099E-01, .672099E-01, .818432E-02, .818655E-02, | |
39881 | & .818655E-02, .818432E-02, .244140E+00, .704188E-02, .668281E-01, | |
39882 | & .668281E-01, .873688E-02, .873927E-02, .873927E-02, .873688E-02, | |
39883 | & .237247E+00, .768463E-02, .662457E-01, .662457E-01, .918650E-02, | |
39884 | & .918903E-02, .918903E-02, .918650E-02, .228043E+00, .821808E-02, | |
39885 | & .654734E-01, .654734E-01, .953502E-02, .953766E-02, .953766E-02, | |
39886 | & .953502E-02, .217054E+00, .864446E-02, .645238E-01, .645238E-01, | |
39887 | & .978645E-02, .978915E-02, .978915E-02, .978645E-02, .204766E+00, | |
39888 | & .896811E-02, .634114E-01, .634114E-01, .994639E-02, .994915E-02, | |
39889 | & .994915E-02, .994639E-02, .191614E+00, .919500E-02, .621515E-01, | |
39890 | & .621515E-01, .100217E-01, .100245E-01, .100245E-01, .100217E-01/ | |
39891 | DATA (DL(K),K= 1871, 1955) / | |
39892 | & .177983E+00, .933229E-02, .607602E-01, .607602E-01, .100200E-01, | |
39893 | & .100228E-01, .100228E-01, .100200E-01, .164201E+00, .938793E-02, | |
39894 | & .592539E-01, .592539E-01, .994938E-02, .995217E-02, .995217E-02, | |
39895 | & .994938E-02, .150544E+00, .937032E-02, .576488E-01, .576488E-01, | |
39896 | & .981814E-02, .982091E-02, .982091E-02, .981814E-02, .137234E+00, | |
39897 | & .928803E-02, .000000E+00, .000000E+00, .000000E+00, .000000E+00, | |
39898 | & .000000E+00, .000000E+00, .000000E+00, .000000E+00, .000000E+00, | |
39899 | & .000000E+00, .000000E+00, .000000E+00, .000000E+00, .000000E+00, | |
39900 | & .000000E+00, .000000E+00, .000000E+00, .000000E+00, .000000E+00, | |
39901 | & .000000E+00, .000000E+00, .000000E+00, .000000E+00, .000000E+00, | |
39902 | & .675167E-01, .675167E-01, .139130E-02, .139130E-02, .139130E-02, | |
39903 | & .139130E-02, .184090E+00, .113841E-17, .680840E-01, .680840E-01, | |
39904 | & .240061E-02, .240097E-02, .240097E-02, .240061E-02, .203559E+00, | |
39905 | & .112278E-02, .684634E-01, .684634E-01, .338513E-02, .338580E-02, | |
39906 | & .338580E-02, .338513E-02, .217944E+00, .221249E-02, .686304E-01, | |
39907 | & .686304E-01, .430938E-02, .431032E-02, .431032E-02, .430938E-02, | |
39908 | & .227068E+00, .323420E-02, .685779E-01, .685779E-01, .515589E-02/ | |
39909 | DATA (DL(K),K= 1956, 2040) / | |
39910 | & .515707E-02, .515707E-02, .515589E-02, .231353E+00, .417091E-02, | |
39911 | & .683023E-01, .683023E-01, .591002E-02, .591140E-02, .591140E-02, | |
39912 | & .591002E-02, .231327E+00, .500843E-02, .678068E-01, .678068E-01, | |
39913 | & .656383E-02, .656537E-02, .656537E-02, .656383E-02, .227606E+00, | |
39914 | & .573925E-02, .670989E-01, .670989E-01, .711344E-02, .711513E-02, | |
39915 | & .711513E-02, .711344E-02, .220833E+00, .635992E-02, .661895E-01, | |
39916 | & .661895E-01, .755852E-02, .756031E-02, .756031E-02, .755852E-02, | |
39917 | & .211624E+00, .687048E-02, .650923E-01, .650923E-01, .790162E-02, | |
39918 | & .790350E-02, .790350E-02, .790162E-02, .200567E+00, .727387E-02, | |
39919 | & .638232E-01, .638232E-01, .814753E-02, .814946E-02, .814946E-02, | |
39920 | & .814753E-02, .188197E+00, .757524E-02, .623994E-01, .623994E-01, | |
39921 | & .830271E-02, .830469E-02, .830469E-02, .830271E-02, .174994E+00, | |
39922 | & .778139E-02, .608390E-01, .608390E-01, .837482E-02, .837682E-02, | |
39923 | & .837682E-02, .837482E-02, .161373E+00, .790029E-02, .591605E-01, | |
39924 | & .591605E-01, .837226E-02, .837426E-02, .837426E-02, .837226E-02, | |
39925 | & .147685E+00, .794065E-02, .573824E-01, .573824E-01, .830376E-02, | |
39926 | & .830575E-02, .830575E-02, .830376E-02, .134218E+00, .791148E-02/ | |
39927 | DATA (DL(K),K= 2041, 2125) / | |
39928 | & .555224E-01, .555224E-01, .817811E-02, .818008E-02, .818008E-02, | |
39929 | & .817811E-02, .121200E+00, .782185E-02, .535980E-01, .535980E-01, | |
39930 | & .800390E-02, .800584E-02, .800584E-02, .800390E-02, .108803E+00, | |
39931 | & .768059E-02, .000000E+00, .000000E+00, .000000E+00, .000000E+00, | |
39932 | & .000000E+00, .000000E+00, .000000E+00, .000000E+00, .000000E+00, | |
39933 | & .000000E+00, .000000E+00, .000000E+00, .000000E+00, .000000E+00, | |
39934 | & .000000E+00, .000000E+00, .000000E+00, .000000E+00, .000000E+00, | |
39935 | & .000000E+00, .000000E+00, .000000E+00, .000000E+00, .000000E+00, | |
39936 | & .703249E-01, .703249E-01, .953926E-03, .953926E-03, .953926E-03, | |
39937 | & .953926E-03, .186497E+00, .108420E-18, .704188E-01, .704188E-01, | |
39938 | & .195267E-02, .195297E-02, .195297E-02, .195267E-02, .202831E+00, | |
39939 | & .108414E-02, .702995E-01, .702995E-01, .290528E-02, .290582E-02, | |
39940 | & .290582E-02, .290528E-02, .213933E+00, .211514E-02, .699499E-01, | |
39941 | & .699499E-01, .377873E-02, .377950E-02, .377950E-02, .377873E-02, | |
39942 | & .219748E+00, .306054E-02, .693699E-01, .693699E-01, .455903E-02, | |
39943 | & .455997E-02, .455997E-02, .455903E-02, .220821E+00, .390679E-02, | |
39944 | & .685634E-01, .685634E-01, .523531E-02, .523640E-02, .523640E-02/ | |
39945 | DATA (DL(K),K= 2126, 2210) / | |
39946 | & .523531E-02, .217787E+00, .464347E-02, .675406E-01, .675406E-01, | |
39947 | & .580340E-02, .580462E-02, .580462E-02, .580340E-02, .211353E+00, | |
39948 | & .526681E-02, .663155E-01, .663155E-01, .626315E-02, .626446E-02, | |
39949 | & .626446E-02, .626315E-02, .202230E+00, .577705E-02, .649052E-01, | |
39950 | & .649052E-01, .661759E-02, .661897E-02, .661897E-02, .661759E-02, | |
39951 | & .191081E+00, .617758E-02, .633285E-01, .633285E-01, .687230E-02, | |
39952 | & .687373E-02, .687373E-02, .687230E-02, .178518E+00, .647434E-02, | |
39953 | & .616058E-01, .616058E-01, .703464E-02, .703611E-02, .703611E-02, | |
39954 | & .703464E-02, .165082E+00, .667499E-02, .597580E-01, .597580E-01, | |
39955 | & .711320E-02, .711468E-02, .711468E-02, .711320E-02, .151241E+00, | |
39956 | & .678842E-02, .578059E-01, .578059E-01, .711723E-02, .711872E-02, | |
39957 | & .711872E-02, .711723E-02, .137382E+00, .682417E-02, .557702E-01, | |
39958 | & .557702E-01, .705628E-02, .705776E-02, .705776E-02, .705628E-02, | |
39959 | & .123821E+00, .679205E-02, .536704E-01, .536704E-01, .693979E-02, | |
39960 | & .694125E-02, .694125E-02, .693979E-02, .110798E+00, .670173E-02, | |
39961 | & .515252E-01, .515252E-01, .677689E-02, .677832E-02, .677832E-02, | |
39962 | & .677689E-02, .984933E-01, .656256E-02, .493519E-01, .493519E-01/ | |
39963 | DATA (DL(K),K= 2211, 2295) / | |
39964 | & .657614E-02, .657753E-02, .657753E-02, .657614E-02, .870270E-01, | |
39965 | & .638332E-02, .000000E+00, .000000E+00, .000000E+00, .000000E+00, | |
39966 | & .000000E+00, .000000E+00, .000000E+00, .000000E+00, .000000E+00, | |
39967 | & .000000E+00, .000000E+00, .000000E+00, .000000E+00, .000000E+00, | |
39968 | & .000000E+00, .000000E+00, .000000E+00, .000000E+00, .000000E+00, | |
39969 | & .000000E+00, .000000E+00, .000000E+00, .000000E+00, .000000E+00, | |
39970 | & .725555E-01, .725555E-01, .636424E-03, .636424E-03, .636424E-03, | |
39971 | & .636424E-03, .190200E+00,-.271051E-17, .721364E-01, .721364E-01, | |
39972 | & .162522E-02, .162546E-02, .162546E-02, .162522E-02, .203770E+00, | |
39973 | & .105090E-02, .714881E-01, .714881E-01, .254763E-02, .254807E-02, | |
39974 | & .254807E-02, .254763E-02, .211914E+00, .202976E-02, .706012E-01, | |
39975 | & .706012E-01, .337323E-02, .337384E-02, .337384E-02, .337323E-02, | |
39976 | & .214704E+00, .290668E-02, .694832E-01, .694832E-01, .409164E-02, | |
39977 | & .409240E-02, .409240E-02, .409164E-02, .212817E+00, .367169E-02, | |
39978 | & .681454E-01, .681454E-01, .469593E-02, .469679E-02, .469679E-02, | |
39979 | & .469593E-02, .207013E+00, .431823E-02, .666048E-01, .666048E-01, | |
39980 | & .518578E-02, .518673E-02, .518673E-02, .518578E-02, .198095E+00/ | |
39981 | DATA (DL(K),K= 2296, 2380) / | |
39982 | & .484637E-02, .648819E-01, .648819E-01, .556473E-02, .556575E-02, | |
39983 | & .556575E-02, .556473E-02, .186850E+00, .525997E-02, .629989E-01, | |
39984 | & .629989E-01, .583908E-02, .584014E-02, .584014E-02, .583908E-02, | |
39985 | & .173986E+00, .556566E-02, .609795E-01, .609795E-01, .601725E-02, | |
39986 | & .601834E-02, .601834E-02, .601725E-02, .160140E+00, .577215E-02, | |
39987 | & .588474E-01, .588474E-01, .610889E-02, .611000E-02, .611000E-02, | |
39988 | & .610889E-02, .145850E+00, .588934E-02, .566261E-01, .566261E-01, | |
39989 | & .612435E-02, .612547E-02, .612547E-02, .612435E-02, .131564E+00, | |
39990 | & .592785E-02, .543385E-01, .543385E-01, .607415E-02, .607526E-02, | |
39991 | & .607526E-02, .607415E-02, .117636E+00, .589841E-02, .520060E-01, | |
39992 | & .520060E-01, .596861E-02, .596970E-02, .596970E-02, .596861E-02, | |
39993 | & .104336E+00, .581156E-02, .496485E-01, .496485E-01, .581753E-02, | |
39994 | & .581860E-02, .581860E-02, .581753E-02, .918563E-01, .567728E-02, | |
39995 | & .472842E-01, .472842E-01, .563002E-02, .563105E-02, .563105E-02, | |
39996 | & .563002E-02, .803205E-01, .550487E-02, .449295E-01, .449295E-01, | |
39997 | & .541435E-02, .541535E-02, .541535E-02, .541435E-02, .697975E-01, | |
39998 | & .530276E-02, .000000E+00, .000000E+00, .000000E+00, .000000E+00/ | |
39999 | DATA (DL(K),K= 2381, 2465) / | |
40000 | & .000000E+00, .000000E+00, .000000E+00, .000000E+00, .000000E+00, | |
40001 | & .000000E+00, .000000E+00, .000000E+00, .000000E+00, .000000E+00, | |
40002 | & .000000E+00, .000000E+00, .000000E+00, .000000E+00, .000000E+00, | |
40003 | & .000000E+00, .000000E+00, .000000E+00, .000000E+00, .000000E+00, | |
40004 | & .742000E-01, .742000E-01, .410482E-03, .410482E-03, .410482E-03, | |
40005 | & .410482E-03, .195273E+00,-.143657E-17, .732296E-01, .732296E-01, | |
40006 | & .138854E-02, .138874E-02, .138874E-02, .138854E-02, .206298E+00, | |
40007 | & .102151E-02, .720241E-01, .720241E-01, .228017E-02, .228054E-02, | |
40008 | & .228054E-02, .228017E-02, .211639E+00, .195225E-02, .705820E-01, | |
40009 | & .705820E-01, .305794E-02, .305844E-02, .305844E-02, .305794E-02, | |
40010 | & .211509E+00, .276522E-02, .689187E-01, .689187E-01, .371549E-02, | |
40011 | & .371609E-02, .371609E-02, .371549E-02, .206745E+00, .345441E-02, | |
40012 | & .670527E-01, .670527E-01, .425016E-02, .425084E-02, .425084E-02, | |
40013 | & .425016E-02, .198254E+00, .401749E-02, .650080E-01, .650080E-01, | |
40014 | & .466572E-02, .466647E-02, .466647E-02, .466572E-02, .186950E+00, | |
40015 | & .445856E-02, .628107E-01, .628107E-01, .496948E-02, .497027E-02, | |
40016 | & .497027E-02, .496948E-02, .173701E+00, .478517E-02, .604878E-01/ | |
40017 | DATA (DL(K),K= 2466, 2550) / | |
40018 | & .604878E-01, .517094E-02, .517175E-02, .517175E-02, .517094E-02, | |
40019 | & .159263E+00, .500709E-02, .580665E-01, .580665E-01, .528116E-02, | |
40020 | & .528199E-02, .528199E-02, .528116E-02, .144287E+00, .513562E-02, | |
40021 | & .555730E-01, .555730E-01, .531181E-02, .531265E-02, .531265E-02, | |
40022 | & .531181E-02, .129304E+00, .518264E-02, .530325E-01, .530325E-01, | |
40023 | & .527468E-02, .527550E-02, .527550E-02, .527468E-02, .114731E+00, | |
40024 | & .516012E-02, .504682E-01, .504682E-01, .518116E-02, .518198E-02, | |
40025 | & .518198E-02, .518116E-02, .100877E+00, .507964E-02, .479014E-01, | |
40026 | & .479014E-01, .504198E-02, .504278E-02, .504278E-02, .504198E-02, | |
40027 | & .879578E-01, .495209E-02, .453511E-01, .453511E-01, .486695E-02, | |
40028 | & .486772E-02, .486772E-02, .486695E-02, .761077E-01, .478741E-02, | |
40029 | & .428340E-01, .428340E-01, .466486E-02, .466560E-02, .466560E-02, | |
40030 | & .466486E-02, .653932E-01, .459453E-02, .403645E-01, .403645E-01, | |
40031 | & .444342E-02, .444413E-02, .444413E-02, .444342E-02, .558281E-01, | |
40032 | & .438128E-02, .000000E+00, .000000E+00, .000000E+00, .000000E+00, | |
40033 | & .000000E+00, .000000E+00, .000000E+00, .000000E+00, .000000E+00, | |
40034 | & .000000E+00, .000000E+00, .000000E+00, .000000E+00, .000000E+00/ | |
40035 | DATA (DL(K),K= 2551, 2635) / | |
40036 | & .000000E+00, .000000E+00, .000000E+00, .000000E+00, .000000E+00, | |
40037 | & .000000E+00, .000000E+00, .000000E+00, .000000E+00, .000000E+00, | |
40038 | & .752337E-01, .752337E-01, .253875E-03, .253875E-03, .253875E-03, | |
40039 | & .253875E-03, .201902E+00,-.159920E-17, .736752E-01, .736752E-01, | |
40040 | & .121909E-02, .121925E-02, .121925E-02, .121909E-02, .210465E+00, | |
40041 | & .994282E-03, .718865E-01, .718865E-01, .207747E-02, .207776E-02, | |
40042 | & .207776E-02, .207747E-02, .212997E+00, .187854E-02, .698746E-01, | |
40043 | & .698746E-01, .280521E-02, .280560E-02, .280560E-02, .280521E-02, | |
40044 | & .209895E+00, .262933E-02, .676629E-01, .676629E-01, .340063E-02, | |
40045 | & .340109E-02, .340109E-02, .340063E-02, .202191E+00, .324527E-02, | |
40046 | & .652775E-01, .652775E-01, .386588E-02, .386641E-02, .386641E-02, | |
40047 | & .386588E-02, .190971E+00, .372876E-02, .627483E-01, .627483E-01, | |
40048 | & .420910E-02, .420967E-02, .420967E-02, .420910E-02, .177278E+00, | |
40049 | & .408818E-02, .601066E-01, .601066E-01, .444148E-02, .444208E-02, | |
40050 | & .444208E-02, .444148E-02, .162071E+00, .433493E-02, .573831E-01, | |
40051 | & .573831E-01, .457564E-02, .457625E-02, .457625E-02, .457564E-02, | |
40052 | & .146148E+00, .448183E-02, .546072E-01, .546072E-01, .462506E-02/ | |
40053 | DATA (DL(K),K= 2636, 2720) / | |
40054 | & .462567E-02, .462567E-02, .462506E-02, .130166E+00, .454252E-02, | |
40055 | & .518065E-01, .518065E-01, .460307E-02, .460368E-02, .460368E-02, | |
40056 | & .460307E-02, .114632E+00, .453052E-02, .490062E-01, .490062E-01, | |
40057 | & .452252E-02, .452312E-02, .452312E-02, .452252E-02, .999175E-01, | |
40058 | & .445880E-02, .462287E-01, .462287E-01, .439529E-02, .439588E-02, | |
40059 | & .439588E-02, .439529E-02, .862750E-01, .433936E-02, .434937E-01, | |
40060 | & .434937E-01, .423211E-02, .423268E-02, .423268E-02, .423211E-02, | |
40061 | & .738542E-01, .418306E-02, .408180E-01, .408180E-01, .404245E-02, | |
40062 | & .404299E-02, .404299E-02, .404245E-02, .627228E-01, .399946E-02, | |
40063 | & .382157E-01, .382157E-01, .383446E-02, .383498E-02, .383498E-02, | |
40064 | & .383446E-02, .528847E-01, .379682E-02, .356980E-01, .356980E-01, | |
40065 | & .361508E-02, .361557E-02, .361557E-02, .361508E-02, .442963E-01, | |
40066 | & .358213E-02, .000000E+00, .000000E+00, .000000E+00, .000000E+00, | |
40067 | & .000000E+00, .000000E+00, .000000E+00, .000000E+00, .000000E+00, | |
40068 | & .000000E+00, .000000E+00, .000000E+00, .000000E+00, .000000E+00, | |
40069 | & .000000E+00, .000000E+00, .000000E+00, .000000E+00, .000000E+00, | |
40070 | & .000000E+00, .000000E+00, .000000E+00, .000000E+00, .000000E+00/ | |
40071 | DATA (DL(K),K= 2721, 2805) / | |
40072 | & .756149E-01, .756149E-01, .148956E-03, .148956E-03, .148956E-03, | |
40073 | & .148956E-03, .210410E+00,-.149078E-18, .734321E-01, .734321E-01, | |
40074 | & .109779E-02, .109791E-02, .109791E-02, .109779E-02, .216444E+00, | |
40075 | & .967243E-03, .710369E-01, .710369E-01, .191860E-02, .191882E-02, | |
40076 | & .191882E-02, .191860E-02, .215992E+00, .180426E-02, .684452E-01, | |
40077 | & .684452E-01, .259230E-02, .259259E-02, .259259E-02, .259230E-02, | |
40078 | & .209697E+00, .249224E-02, .656884E-01, .656884E-01, .312270E-02, | |
40079 | & .312305E-02, .312305E-02, .312270E-02, .198844E+00, .303522E-02, | |
40080 | & .627994E-01, .627994E-01, .351747E-02, .351786E-02, .351786E-02, | |
40081 | & .351747E-02, .184740E+00, .344105E-02, .598138E-01, .598138E-01, | |
40082 | & .378940E-02, .378981E-02, .378981E-02, .378940E-02, .168578E+00, | |
40083 | & .372269E-02, .567666E-01, .567666E-01, .395362E-02, .395405E-02, | |
40084 | & .395405E-02, .395362E-02, .151409E+00, .389544E-02, .536907E-01, | |
40085 | & .536907E-01, .402569E-02, .402613E-02, .402613E-02, .402569E-02, | |
40086 | & .134065E+00, .397499E-02, .506163E-01, .506163E-01, .402117E-02, | |
40087 | & .402161E-02, .402161E-02, .402117E-02, .117191E+00, .397702E-02, | |
40088 | & .475706E-01, .475706E-01, .395467E-02, .395511E-02, .395511E-02/ | |
40089 | DATA (DL(K),K= 2806, 2890) / | |
40090 | & .395467E-02, .101250E+00, .391626E-02, .445771E-01, .445771E-01, | |
40091 | & .383961E-02, .384003E-02, .384003E-02, .383961E-02, .865500E-01, | |
40092 | & .380621E-02, .416559E-01, .416559E-01, .368789E-02, .368830E-02, | |
40093 | & .368830E-02, .368789E-02, .732657E-01, .365888E-02, .388235E-01, | |
40094 | & .388235E-01, .350985E-02, .351025E-02, .351025E-02, .350985E-02, | |
40095 | & .614686E-01, .348466E-02, .360931E-01, .360931E-01, .331425E-02, | |
40096 | & .331462E-02, .331462E-02, .331425E-02, .511511E-01, .329240E-02, | |
40097 | & .334751E-01, .334751E-01, .310835E-02, .310870E-02, .310870E-02, | |
40098 | & .310835E-02, .422485E-01, .308941E-02, .309768E-01, .309768E-01, | |
40099 | & .289805E-02, .289838E-02, .289838E-02, .289805E-02, .346590E-01, | |
40100 | & .288164E-02, .000000E+00, .000000E+00, .000000E+00, .000000E+00, | |
40101 | & .000000E+00, .000000E+00, .000000E+00, .000000E+00, .000000E+00, | |
40102 | & .000000E+00, .000000E+00, .000000E+00, .000000E+00, .000000E+00, | |
40103 | & .000000E+00, .000000E+00, .000000E+00, .000000E+00, .000000E+00, | |
40104 | & .000000E+00, .000000E+00, .000000E+00, .000000E+00, .000000E+00, | |
40105 | & .752796E-01, .752796E-01, .816906E-04, .816906E-04, .816906E-04, | |
40106 | & .816906E-04, .221322E+00, .298156E-18, .724376E-01, .724376E-01/ | |
40107 | DATA (DL(K),K= 2891, 2975) / | |
40108 | & .100884E-02, .100894E-02, .100894E-02, .100884E-02, .224569E+00, | |
40109 | & .938046E-03, .694166E-01, .694166E-01, .178592E-02, .178609E-02, | |
40110 | & .178609E-02, .178592E-02, .220745E+00, .172460E-02, .662414E-01, | |
40111 | & .662414E-01, .240001E-02, .240024E-02, .240024E-02, .240001E-02, | |
40112 | & .210839E+00, .234694E-02, .629511E-01, .629511E-01, .286144E-02, | |
40113 | & .286171E-02, .286171E-02, .286144E-02, .196463E+00, .281556E-02, | |
40114 | & .595849E-01, .595849E-01, .318412E-02, .318441E-02, .318441E-02, | |
40115 | & .318412E-02, .179204E+00, .314448E-02, .561822E-01, .561822E-01, | |
40116 | & .338573E-02, .338605E-02, .338605E-02, .338573E-02, .160420E+00, | |
40117 | & .335151E-02, .527801E-01, .527801E-01, .348530E-02, .348562E-02, | |
40118 | & .348562E-02, .348530E-02, .141254E+00, .345578E-02, .494117E-01, | |
40119 | & .494117E-01, .350098E-02, .350131E-02, .350131E-02, .350098E-02, | |
40120 | & .122547E+00, .347555E-02, .461061E-01, .461061E-01, .344994E-02, | |
40121 | & .345026E-02, .345026E-02, .344994E-02, .104908E+00, .342804E-02, | |
40122 | & .428876E-01, .428876E-01, .334753E-02, .334784E-02, .334784E-02, | |
40123 | & .334753E-02, .887264E-01, .332868E-02, .397764E-01, .397764E-01, | |
40124 | & .320718E-02, .320748E-02, .320748E-02, .320718E-02, .742160E-01/ | |
40125 | DATA (DL(K),K= 2976, 3060) / | |
40126 | & .319097E-02, .367882E-01, .367882E-01, .304033E-02, .304062E-02, | |
40127 | & .304062E-02, .304033E-02, .614556E-01, .302641E-02, .339348E-01, | |
40128 | & .339348E-01, .285650E-02, .285677E-02, .285677E-02, .285650E-02, | |
40129 | & .504214E-01, .284454E-02, .312247E-01, .312247E-01, .266337E-02, | |
40130 | & .266363E-02, .266363E-02, .266337E-02, .410205E-01, .265311E-02, | |
40131 | & .286629E-01, .286629E-01, .246705E-02, .246730E-02, .246730E-02, | |
40132 | & .246705E-02, .331166E-01, .245826E-02, .262521E-01, .262521E-01, | |
40133 | & .227226E-02, .227248E-02, .227248E-02, .227226E-02, .265498E-01, | |
40134 | & .226473E-02, .000000E+00, .000000E+00, .000000E+00, .000000E+00, | |
40135 | & .000000E+00, .000000E+00, .000000E+00, .000000E+00, .000000E+00, | |
40136 | & .000000E+00, .000000E+00, .000000E+00, .000000E+00, .000000E+00, | |
40137 | & .000000E+00, .000000E+00, .000000E+00, .000000E+00, .000000E+00, | |
40138 | & .000000E+00, .000000E+00, .000000E+00, .000000E+00, .000000E+00, | |
40139 | & .741335E-01, .741335E-01, .409835E-04, .409835E-04, .409835E-04, | |
40140 | & .409835E-04, .235495E+00,-.158395E-17, .705990E-01, .705990E-01, | |
40141 | & .938808E-03, .938883E-03, .938883E-03, .938808E-03, .235413E+00, | |
40142 | & .903728E-03, .669383E-01, .669383E-01, .166382E-02, .166395E-02/ | |
40143 | DATA (DL(K),K= 3061, 3145) / | |
40144 | & .166395E-02, .166382E-02, .227523E+00, .163381E-02, .631853E-01, | |
40145 | & .631853E-01, .221128E-02, .221145E-02, .221145E-02, .221128E-02, | |
40146 | & .213316E+00, .218562E-02, .593855E-01, .593855E-01, .259911E-02, | |
40147 | & .259931E-02, .259931E-02, .259911E-02, .194833E+00, .257720E-02, | |
40148 | & .555825E-01, .555825E-01, .284819E-02, .284841E-02, .284841E-02, | |
40149 | & .284819E-02, .174012E+00, .282950E-02, .518174E-01, .518174E-01, | |
40150 | & .298117E-02, .298140E-02, .298140E-02, .298117E-02, .152385E+00, | |
40151 | & .296523E-02, .481268E-01, .481268E-01, .302067E-02, .302090E-02, | |
40152 | & .302090E-02, .302067E-02, .131168E+00, .300708E-02, .445413E-01, | |
40153 | & .445413E-01, .298689E-02, .298712E-02, .298712E-02, .298689E-02, | |
40154 | & .111177E+00, .297532E-02, .410859E-01, .410859E-01, .289793E-02, | |
40155 | & .289815E-02, .289815E-02, .289793E-02, .929352E-01, .288809E-02, | |
40156 | & .377798E-01, .377798E-01, .276920E-02, .276941E-02, .276941E-02, | |
40157 | & .276920E-02, .767178E-01, .276084E-02, .346372E-01, .346372E-01, | |
40158 | & .261353E-02, .261373E-02, .261373E-02, .261353E-02, .626102E-01, | |
40159 | & .260643E-02, .316676E-01, .316676E-01, .244134E-02, .244154E-02, | |
40160 | & .244154E-02, .244134E-02, .505665E-01, .243531E-02, .288765E-01/ | |
40161 | DATA (DL(K),K= 3146, 3230) / | |
40162 | & .288765E-01, .226087E-02, .226105E-02, .226105E-02, .226087E-02, | |
40163 | & .404527E-01, .225576E-02, .262660E-01, .262660E-01, .207845E-02, | |
40164 | & .207862E-02, .207862E-02, .207845E-02, .320820E-01, .207412E-02, | |
40165 | & .238351E-01, .238351E-01, .189881E-02, .189897E-02, .189897E-02, | |
40166 | & .189881E-02, .252422E-01, .189514E-02, .215808E-01, .215808E-01, | |
40167 | & .172536E-02, .172551E-02, .172551E-02, .172536E-02, .197186E-01, | |
40168 | & .172225E-02, .000000E+00, .000000E+00, .000000E+00, .000000E+00, | |
40169 | & .000000E+00, .000000E+00, .000000E+00, .000000E+00, .000000E+00, | |
40170 | & .000000E+00, .000000E+00, .000000E+00, .000000E+00, .000000E+00, | |
40171 | & .000000E+00, .000000E+00, .000000E+00, .000000E+00, .000000E+00, | |
40172 | & .000000E+00, .000000E+00, .000000E+00, .000000E+00, .000000E+00, | |
40173 | & .720339E-01, .720339E-01, .181946E-04, .181946E-04, .181946E-04, | |
40174 | & .181946E-04, .254393E+00, .469256E-18, .677768E-01, .677768E-01, | |
40175 | & .875835E-03, .875888E-03, .875888E-03, .875835E-03, .249966E+00, | |
40176 | & .860480E-03, .634725E-01, .634725E-01, .153792E-02, .153801E-02, | |
40177 | & .153801E-02, .153792E-02, .236824E+00, .152496E-02, .591619E-01, | |
40178 | & .591619E-01, .201036E-02, .201048E-02, .201048E-02, .201036E-02/ | |
40179 | DATA (DL(K),K= 3231, 3315) / | |
40180 | & .217211E+00, .199944E-02, .548948E-01, .548948E-01, .231978E-02, | |
40181 | & .231992E-02, .231992E-02, .231978E-02, .193739E+00, .231058E-02, | |
40182 | & .507162E-01, .507162E-01, .249460E-02, .249475E-02, .249475E-02, | |
40183 | & .249460E-02, .168773E+00, .248686E-02, .466653E-01, .466653E-01, | |
40184 | & .256217E-02, .256232E-02, .256232E-02, .256217E-02, .144012E+00, | |
40185 | & .255566E-02, .427744E-01, .427744E-01, .254804E-02, .254820E-02, | |
40186 | & .254820E-02, .254804E-02, .120695E+00, .254258E-02, .390676E-01, | |
40187 | & .390676E-01, .247365E-02, .247380E-02, .247380E-02, .247365E-02, | |
40188 | & .995452E-01, .246906E-02, .355626E-01, .355626E-01, .235710E-02, | |
40189 | & .235725E-02, .235725E-02, .235710E-02, .809281E-01, .235325E-02, | |
40190 | & .322703E-01, .322703E-01, .221303E-02, .221317E-02, .221317E-02, | |
40191 | & .221303E-02, .649429E-01, .220980E-02, .291963E-01, .291963E-01, | |
40192 | & .205294E-02, .205307E-02, .205307E-02, .205294E-02, .515039E-01, | |
40193 | & .205024E-02, .263419E-01, .263419E-01, .188569E-02, .188581E-02, | |
40194 | & .188581E-02, .188569E-02, .404102E-01, .188343E-02, .237044E-01, | |
40195 | & .237044E-01, .171783E-02, .171795E-02, .171795E-02, .171783E-02, | |
40196 | & .313959E-01, .171594E-02, .212782E-01, .212782E-01, .155409E-02/ | |
40197 | DATA (DL(K),K= 3316, 3400) / | |
40198 | & .155419E-02, .155419E-02, .155409E-02, .241750E-01, .155251E-02, | |
40199 | & .190555E-01, .190555E-01, .139767E-02, .139777E-02, .139777E-02, | |
40200 | & .139767E-02, .184646E-01, .139635E-02, .170270E-01, .170270E-01, | |
40201 | & .125065E-02, .125074E-02, .125074E-02, .125065E-02, .139996E-01, | |
40202 | & .124955E-02, .000000E+00, .000000E+00, .000000E+00, .000000E+00, | |
40203 | & .000000E+00, .000000E+00, .000000E+00, .000000E+00, .000000E+00, | |
40204 | & .000000E+00, .000000E+00, .000000E+00, .000000E+00, .000000E+00, | |
40205 | & .000000E+00, .000000E+00, .000000E+00, .000000E+00, .000000E+00, | |
40206 | & .000000E+00, .000000E+00, .000000E+00, .000000E+00, .000000E+00, | |
40207 | & .687547E-01, .687547E-01, .676181E-05, .676181E-05, .676181E-05, | |
40208 | & .676181E-05, .280728E+00,-.145838E-17, .637529E-01, .637529E-01, | |
40209 | & .808781E-03, .808818E-03, .808818E-03, .808781E-03, .270033E+00, | |
40210 | & .803169E-03, .588180E-01, .588180E-01, .139388E-02, .139394E-02, | |
40211 | & .139394E-02, .139388E-02, .249568E+00, .138922E-02, .539945E-01, | |
40212 | & .539945E-01, .178168E-02, .178176E-02, .178176E-02, .178168E-02, | |
40213 | & .222743E+00, .177782E-02, .493317E-01, .493317E-01, .200838E-02, | |
40214 | & .200848E-02, .200848E-02, .200838E-02, .192919E+00, .200519E-02/ | |
40215 | DATA (DL(K),K= 3401, 3485) / | |
40216 | & .448709E-01, .448709E-01, .211009E-02, .211019E-02, .211019E-02, | |
40217 | & .211009E-02, .162975E+00, .210745E-02, .406433E-01, .406433E-01, | |
40218 | & .211805E-02, .211815E-02, .211815E-02, .211805E-02, .134716E+00, | |
40219 | & .211586E-02, .366716E-01, .366716E-01, .205957E-02, .205968E-02, | |
40220 | & .205968E-02, .205957E-02, .109289E+00, .205776E-02, .329687E-01, | |
40221 | & .329687E-01, .195606E-02, .195616E-02, .195616E-02, .195606E-02, | |
40222 | & .871955E-01, .195457E-02, .295400E-01, .295400E-01, .182447E-02, | |
40223 | & .182456E-02, .182456E-02, .182447E-02, .685399E-01, .182323E-02, | |
40224 | & .263849E-01, .263849E-01, .167765E-02, .167774E-02, .167774E-02, | |
40225 | & .167765E-02, .531615E-01, .167663E-02, .234975E-01, .234975E-01, | |
40226 | & .152505E-02, .152514E-02, .152514E-02, .152505E-02, .407334E-01, | |
40227 | & .152421E-02, .208683E-01, .208683E-01, .137342E-02, .137350E-02, | |
40228 | & .137350E-02, .137342E-02, .308674E-01, .137273E-02, .184852E-01, | |
40229 | & .184852E-01, .122732E-02, .122739E-02, .122739E-02, .122732E-02, | |
40230 | & .231578E-01, .122675E-02, .163340E-01, .163340E-01, .108968E-02, | |
40231 | & .108975E-02, .108975E-02, .108968E-02, .172149E-01, .108921E-02, | |
40232 | & .143996E-01, .143996E-01, .962198E-03, .962260E-03, .962260E-03/ | |
40233 | DATA (DL(K),K= 3486, 3570) / | |
40234 | & .962198E-03, .126908E-01, .961815E-03, .126661E-01, .126661E-01, | |
40235 | & .845675E-03, .845732E-03, .845732E-03, .845675E-03, .928555E-02, | |
40236 | & .845361E-03, .000000E+00, .000000E+00, .000000E+00, .000000E+00, | |
40237 | & .000000E+00, .000000E+00, .000000E+00, .000000E+00, .000000E+00, | |
40238 | & .000000E+00, .000000E+00, .000000E+00, .000000E+00, .000000E+00, | |
40239 | & .000000E+00, .000000E+00, .000000E+00, .000000E+00, .000000E+00, | |
40240 | & .000000E+00, .000000E+00, .000000E+00, .000000E+00, .000000E+00, | |
40241 | & .639050E-01, .639050E-01, .189600E-05, .189600E-05, .189600E-05, | |
40242 | & .189600E-05, .320203E+00, .545701E-18, .581555E-01, .581555E-01, | |
40243 | & .725861E-03, .725886E-03, .725886E-03, .725861E-03, .299305E+00, | |
40244 | & .724320E-03, .526376E-01, .526376E-01, .121568E-02, .121572E-02, | |
40245 | & .121572E-02, .121568E-02, .267591E+00, .121442E-02, .473911E-01, | |
40246 | & .473911E-01, .150820E-02, .150825E-02, .150825E-02, .150820E-02, | |
40247 | & .230364E+00, .150718E-02, .424558E-01, .424558E-01, .164949E-02, | |
40248 | & .164955E-02, .164955E-02, .164949E-02, .191972E+00, .164867E-02, | |
40249 | & .378600E-01, .378600E-01, .168256E-02, .168262E-02, .168262E-02, | |
40250 | & .168256E-02, .155818E+00, .168189E-02, .336181E-01, .336181E-01/ | |
40251 | DATA (DL(K),K= 3571, 3655) / | |
40252 | & .164080E-02, .164086E-02, .164086E-02, .164080E-02, .123609E+00, | |
40253 | & .164026E-02, .297349E-01, .297349E-01, .155136E-02, .155142E-02, | |
40254 | & .155142E-02, .155136E-02, .961680E-01, .155092E-02, .262052E-01, | |
40255 | & .262052E-01, .143382E-02, .143388E-02, .143388E-02, .143382E-02, | |
40256 | & .735522E-01, .143346E-02, .230171E-01, .230171E-01, .130247E-02, | |
40257 | & .130253E-02, .130253E-02, .130247E-02, .553916E-01, .130218E-02, | |
40258 | & .201539E-01, .201539E-01, .116733E-02, .116739E-02, .116739E-02, | |
40259 | & .116733E-02, .411453E-01, .116710E-02, .175955E-01, .175955E-01, | |
40260 | & .103505E-02, .103510E-02, .103510E-02, .103505E-02, .301858E-01, | |
40261 | & .103486E-02, .153199E-01, .153199E-01, .909828E-03, .909880E-03, | |
40262 | & .909880E-03, .909828E-03, .218957E-01, .909677E-03, .133043E-01, | |
40263 | & .133043E-01, .794097E-03, .794146E-03, .794146E-03, .794097E-03, | |
40264 | & .157204E-01, .793976E-03, .115259E-01, .115259E-01, .689012E-03, | |
40265 | & .689057E-03, .689057E-03, .689012E-03, .111816E-01, .688913E-03, | |
40266 | & .996208E-02, .996208E-02, .594880E-03, .594922E-03, .594922E-03, | |
40267 | & .594880E-03, .788559E-02, .594801E-03, .859151E-02, .859151E-02, | |
40268 | & .511455E-03, .511493E-03, .511493E-03, .511455E-03, .551865E-02/ | |
40269 | DATA (DL(K),K= 3656, 3740) / | |
40270 | & .511392E-03, .000000E+00, .000000E+00, .000000E+00, .000000E+00, | |
40271 | & .000000E+00, .000000E+00, .000000E+00, .000000E+00, .000000E+00, | |
40272 | & .000000E+00, .000000E+00, .000000E+00, .000000E+00, .000000E+00, | |
40273 | & .000000E+00, .000000E+00, .000000E+00, .000000E+00, .000000E+00, | |
40274 | & .000000E+00, .000000E+00, .000000E+00, .000000E+00, .000000E+00, | |
40275 | & .567030E-01, .567030E-01, .317692E-06, .317692E-06, .317692E-06, | |
40276 | & .317692E-06, .387655E+00,-.196551E-18, .502560E-01, .502560E-01, | |
40277 | & .611827E-03, .611838E-03, .611838E-03, .611827E-03, .346975E+00, | |
40278 | & .611576E-03, .442838E-01, .442838E-01, .981907E-03, .981929E-03, | |
40279 | & .981929E-03, .981907E-03, .295290E+00, .981708E-03, .388018E-01, | |
40280 | & .388018E-01, .116826E-02, .116829E-02, .116829E-02, .116826E-02, | |
40281 | & .241157E+00, .116810E-02, .338227E-01, .338227E-01, .122537E-02, | |
40282 | & .122541E-02, .122541E-02, .122537E-02, .190062E+00, .122525E-02, | |
40283 | & .293442E-01, .293442E-01, .120047E-02, .120052E-02, .120052E-02, | |
40284 | & .120047E-02, .145706E+00, .120037E-02, .253494E-01, .253494E-01, | |
40285 | & .112580E-02, .112585E-02, .112585E-02, .112580E-02, .109110E+00, | |
40286 | & .112572E-02, .218132E-01, .218132E-01, .102498E-02, .102503E-02/ | |
40287 | DATA (DL(K),K= 3741, 3825) / | |
40288 | & .102503E-02, .102498E-02, .800661E-01, .102492E-02, .187030E-01, | |
40289 | & .187030E-01, .913395E-03, .913450E-03, .913450E-03, .913395E-03, | |
40290 | & .577342E-01, .913348E-03, .159833E-01, .159833E-01, .800935E-03, | |
40291 | & .800990E-03, .800990E-03, .800935E-03, .409782E-01, .800898E-03, | |
40292 | & .136172E-01, .136172E-01, .693698E-03, .693751E-03, .693751E-03, | |
40293 | & .693698E-03, .286780E-01, .693669E-03, .115681E-01, .115681E-01, | |
40294 | & .595013E-03, .595064E-03, .595064E-03, .595013E-03, .198197E-01, | |
40295 | & .594990E-03, .980105E-02, .980105E-02, .506423E-03, .506471E-03, | |
40296 | & .506471E-03, .506423E-03, .135410E-01, .506405E-03, .828286E-02, | |
40297 | & .828286E-02, .428323E-03, .428368E-03, .428368E-03, .428323E-03, | |
40298 | & .915498E-02, .428309E-03, .698303E-02, .698303E-02, .360397E-03, | |
40299 | & .360439E-03, .360439E-03, .360397E-03, .613133E-02, .360386E-03, | |
40300 | & .587373E-02, .587373E-02, .301934E-03, .301973E-03, .301973E-03, | |
40301 | & .301934E-03, .407092E-02, .301925E-03, .492985E-02, .492985E-02, | |
40302 | & .252029E-03, .252064E-03, .252064E-03, .252029E-03, .268179E-02, | |
40303 | & .252022E-03, .000000E+00, .000000E+00, .000000E+00, .000000E+00, | |
40304 | & .000000E+00, .000000E+00, .000000E+00, .000000E+00, .000000E+00/ | |
40305 | DATA (DL(K),K= 3826, 3910) / | |
40306 | & .000000E+00, .000000E+00, .000000E+00, .000000E+00, .000000E+00, | |
40307 | & .000000E+00, .000000E+00, .000000E+00, .000000E+00, .000000E+00, | |
40308 | & .000000E+00, .000000E+00, .000000E+00, .000000E+00, .000000E+00, | |
40309 | & .450567E-01, .450567E-01, .151200E-07, .151200E-07, .151200E-07, | |
40310 | & .151200E-07, .542258E+00,-.767310E-18, .381624E-01, .381624E-01, | |
40311 | & .438685E-03, .438751E-03, .438751E-03, .438685E-03, .447480E+00, | |
40312 | & .438674E-03, .321250E-01, .321250E-01, .653465E-03, .653574E-03, | |
40313 | & .653574E-03, .653465E-03, .347952E+00, .653456E-03, .268827E-01, | |
40314 | & .268827E-01, .724735E-03, .724868E-03, .724868E-03, .724735E-03, | |
40315 | & .258636E+00, .724728E-03, .223751E-01, .223751E-01, .709421E-03, | |
40316 | & .709567E-03, .709567E-03, .709421E-03, .185088E+00, .709417E-03, | |
40317 | & .185359E-01, .185359E-01, .650478E-03, .650626E-03, .650626E-03, | |
40318 | & .650478E-03, .128686E+00, .650474E-03, .152906E-01, .152906E-01, | |
40319 | & .572423E-03, .572567E-03, .572567E-03, .572423E-03, .873875E-01, | |
40320 | & .572420E-03, .125654E-01, .125654E-01, .490165E-03, .490302E-03, | |
40321 | & .490302E-03, .490165E-03, .581141E-01, .490163E-03, .102901E-01, | |
40322 | & .102901E-01, .411740E-03, .411866E-03, .411866E-03, .411740E-03/ | |
40323 | DATA (DL(K),K= 3911, 3995) / | |
40324 | & .379596E-01, .411738E-03, .839975E-02, .839975E-02, .340986E-03, | |
40325 | & .341101E-03, .341101E-03, .340986E-03, .244073E-01, .340985E-03, | |
40326 | & .683634E-02, .683634E-02, .279417E-03, .279520E-03, .279520E-03, | |
40327 | & .279417E-03, .154717E-01, .279416E-03, .554846E-02, .554846E-02, | |
40328 | & .227114E-03, .227204E-03, .227204E-03, .227114E-03, .968450E-02, | |
40329 | & .227113E-03, .449143E-02, .449143E-02, .183425E-03, .183504E-03, | |
40330 | & .183504E-03, .183425E-03, .599306E-02, .183425E-03, .362676E-02, | |
40331 | & .362676E-02, .147387E-03, .147455E-03, .147455E-03, .147387E-03, | |
40332 | & .366977E-02, .147387E-03, .292164E-02, .292164E-02, .117936E-03, | |
40333 | & .117995E-03, .117995E-03, .117936E-03, .222583E-02, .117936E-03, | |
40334 | & .234830E-02, .234830E-02, .940414E-04, .940914E-04, .940914E-04, | |
40335 | & .940414E-04, .133844E-02, .940412E-04, .188339E-02, .188339E-02, | |
40336 | & .747651E-04, .748074E-04, .748074E-04, .747651E-04, .798451E-03, | |
40337 | & .747649E-04, .000000E+00, .000000E+00, .000000E+00, .000000E+00, | |
40338 | & .000000E+00, .000000E+00, .000000E+00, .000000E+00, .000000E+00, | |
40339 | & .000000E+00, .000000E+00, .000000E+00, .000000E+00, .000000E+00, | |
40340 | & .000000E+00, .000000E+00, .000000E+00, .000000E+00, .000000E+00/ | |
40341 | DATA (DL(K),K= 3996, 4000) / | |
40342 | & .000000E+00, .000000E+00, .000000E+00, .000000E+00, .000000E+00/ | |
40343 | ||
40344 | DO 10 I=1,7 | |
40345 | QQ(I) = 0. | |
40346 | 10 CONTINUE | |
40347 | IF(X.GT.0.9985) RETURN | |
40348 | ||
40349 | IS = S/DELTA+1 | |
40350 | IS = MIN(IS,19) | |
40351 | IS1 = IS+1 | |
40352 | DO 20 I=1,7 | |
40353 | IF(I.EQ.3.AND.X.GT.0.95) GOTO 19 | |
40354 | IF(I.EQ.8.AND.X.GT.0.95) GOTO 19 | |
40355 | DO 30 L=1,25 | |
40356 | F1(L)=GF(I,IS,L) | |
40357 | F2(L)=GF(I,IS1,L) | |
40358 | 30 CONTINUE | |
40359 | S1=(IS-1)*DELTA | |
40360 | S2=S1+DELTA | |
40361 | A1 = PHO_CKMTFV(X,F1) | |
40362 | A2 = PHO_CKMTFV(X,F2) | |
40363 | QQ(I)=A1*(S2-S)/DELTA+A2*(S-S1)/DELTA | |
40364 | 19 CONTINUE | |
40365 | 20 CONTINUE | |
40366 | ||
40367 | END | |
40368 | ||
40369 | *$ CREATE PHO_CKMTFV.FOR | |
40370 | *COPY PHO_CKMTFV | |
40371 | CDECK ID>, PHO_CKMTFV | |
40372 | REAL FUNCTION PHO_CKMTFV(X,FVL) | |
40373 | C********************************************************************** | |
40374 | C | |
40375 | C LOGARITHMIC INTERPOLATOR - WATCH OUT FOR NEGATIVE | |
40376 | C FUNCTIONS AND/OR X VALUES OUTSIDE THE RANGE 0 TO 1. | |
40377 | C NOTE: DIMENSION OF FVL IS OVERWRITTEN BY VALUE USED | |
40378 | C IN MAIN ROUTINE. | |
40379 | C | |
40380 | C********************************************************************** | |
40381 | SAVE | |
40382 | ||
40383 | DIMENSION FVL(25),XGRID(25) | |
40384 | ||
40385 | C input/output channels | |
40386 | INTEGER LI,LO | |
40387 | COMMON /POINOU/ LI,LO | |
40388 | ||
40389 | DATA NX,XGRID/25,.001,.002,.004,.008,.016,.032,.064,.1,.15, | |
40390 | *.2,.25,.3,.35,.4,.45,.5,.55,.6,.65,.7,.75,.8,.85,.9,.95/ | |
40391 | ||
40392 | PHO_CKMTFV=0. | |
40393 | DO 1 I=1,NX | |
40394 | IF(X.LT.XGRID(I)) GO TO 2 | |
40395 | 1 CONTINUE | |
40396 | 2 I=I-1 | |
40397 | IF(I.EQ.0) THEN | |
40398 | I=I+1 | |
40399 | ELSE IF(I.GT.23) THEN | |
40400 | I=23 | |
40401 | ENDIF | |
40402 | J=I+1 | |
40403 | K=J+1 | |
40404 | AXI=LOG(XGRID(I)) | |
40405 | BXI=LOG(1.-XGRID(I)) | |
40406 | AXJ=LOG(XGRID(J)) | |
40407 | BXJ=LOG(1.-XGRID(J)) | |
40408 | AXK=LOG(XGRID(K)) | |
40409 | BXK=LOG(1.-XGRID(K)) | |
40410 | FI=LOG(ABS(FVL(I)) +1.E-15) | |
40411 | FJ=LOG(ABS(FVL(J)) +1.E-16) | |
40412 | FK=LOG(ABS(FVL(K)) +1.E-17) | |
40413 | DET=AXI*(BXJ-BXK)+AXJ*(BXK-BXI)+AXK*(BXI-BXJ) | |
40414 | ALOGA=(FI*(AXJ*BXK-AXK*BXJ)+FJ*(AXK*BXI-AXI*BXK)+FK*(AXI*BXJ-AXJ* | |
40415 | $ BXI))/DET | |
40416 | ALPHA=(FI*(BXJ-BXK)+FJ*(BXK-BXI)+FK*(BXI-BXJ))/DET | |
40417 | BETA=(FI*(AXK-AXJ)+FJ*(AXI-AXK)+FK*(AXJ-AXI))/DET | |
40418 | IF(ABS(ALPHA).GT.99..OR.ABS(BETA).GT.99..OR.ABS(ALOGA).GT.99.) | |
40419 | 1RETURN | |
40420 | C IF(ALPHA.GT.50..OR.BETA.GT.50.) THEN | |
40421 | C WRITE(LO,2001) X,FVL | |
40422 | C 2001 FORMAT(8E12.4) | |
40423 | C WRITE(LO,2001) ALPHA,BETA,ALOGA,DET | |
40424 | C ENDIF | |
40425 | PHO_CKMTFV=EXP(ALOGA)*X**ALPHA*(1.-X)**BETA | |
40426 | ||
40427 | END | |
40428 | ||
40429 | *$ CREATE PHO_SASGAM.FOR | |
40430 | *COPY PHO_SASGAM | |
40431 | CDECK ID>, PHO_SASGAM | |
40432 | C*********************************************************************** | |
40433 | C...SaSgam version 2 - parton distributions of the photon | |
40434 | C...by Gerhard A. Schuler and Torbjorn Sjostrand | |
40435 | C...For further information see Z. Phys. C68 (1995) 607 | |
40436 | C...and Phys. Lett. B376 (1996) 193. | |
40437 | ||
40438 | C...18 January 1996: original code. | |
40439 | C...22 July 1996: calculation of BETA moved in SASBEH. | |
40440 | ||
40441 | C!!!Note that one further call parameter - IP2 - has been added | |
40442 | C!!!to the SASGAM argument list compared with version 1. | |
40443 | ||
40444 | C...The user should only need to call the SASGAM routine, | |
40445 | C...which in turn calls the auxiliary routines SASVMD, SASANO, | |
40446 | C...SASBEH and SASDIR. The package is self-contained. | |
40447 | ||
40448 | C...One particular aspect of these parametrizations is that F2 for | |
40449 | C...the photon is not obtained just as the charge-squared-weighted | |
40450 | C...sum of quark distributions, but differ in the treatment of | |
40451 | C...heavy flavours (in F2 the DIS relation W2 = Q2*(1-x)/x restricts | |
40452 | C...the kinematics range of heavy-flavour production, but the same | |
40453 | C...kinematics is not relevant e.g. for jet production) and, for the | |
40454 | C...'MSbar' fits, in the addition of a Cgamma term related to the | |
40455 | C...separation of direct processes. Schematically: | |
40456 | C...PDF = VMD (rho, omega, phi) + anomalous (d, u, s, c, b). | |
40457 | C...F2 = VMD (rho, omega, phi) + anomalous (d, u, s) + | |
40458 | C... Bethe-Heitler (c, b) (+ Cgamma (d, u, s)). | |
40459 | C...The J/psi and Upsilon states have not been included in the VMD sum, | |
40460 | C...but low c and b masses in the other components should compensate | |
40461 | C...for this in a duality sense. | |
40462 | ||
40463 | C...The calling sequence is the following: | |
40464 | C CALL SASGAM(ISET,X,Q2,P2,IP2,F2GM,XPDFGM) | |
40465 | C...with the following declaration statement: | |
40466 | C DIMENSION XPDFGM(-6:6) | |
40467 | C...and, optionally, further information in: | |
40468 | C COMMON/SASCOM/XPVMD(-6:6),XPANL(-6:6),XPANH(-6:6),XPBEH(-6:6), | |
40469 | C &XPDIR(-6:6) | |
40470 | C COMMON/SASVAL/VXPVMD(-6:6),VXPANL(-6:6),VXPANH(-6:6),VXPDGM(-6:6) | |
40471 | C...Input: ISET = 1 : SaS set 1D ('DIS', Q0 = 0.6 GeV) | |
40472 | C = 2 : SaS set 1M ('MSbar', Q0 = 0.6 GeV) | |
40473 | C = 3 : SaS set 2D ('DIS', Q0 = 2 GeV) | |
40474 | C = 4 : SaS set 2M ('MSbar', Q0 = 2 GeV) | |
40475 | C X : x value. | |
40476 | C Q2 : Q2 value. | |
40477 | C P2 : P2 value; should be = 0. for an on-shell photon. | |
40478 | C IP2 : scheme used to evaluate off-shell anomalous component. | |
40479 | C = 0 : recommended default, see = 7. | |
40480 | C = 1 : dipole dampening by integration; very time-consuming. | |
40481 | C = 2 : P_0^2 = max( Q_0^2, P^2 ) | |
40482 | C = 3 : P_0^2 = Q_0^2 + P^2. | |
40483 | C = 4 : P_{eff} that preserves momentum sum. | |
40484 | C = 5 : P_{int} that preserves momentum and average | |
40485 | C evolution range. | |
40486 | C = 6 : P_{eff}, matched to P_0 in P2 -> Q2 limit. | |
40487 | C = 7 : P_{eff}, matched to P_0 in P2 -> Q2 limit. | |
40488 | C...Output: F2GM : F2 value of the photon (including factors of alpha_em). | |
40489 | C XPFDGM : x times parton distribution functions of the photon, | |
40490 | C with elements 0 = g, 1 = d, 2 = u, 3 = s, 4 = c, 5 = b, | |
40491 | C 6 = t (always empty!), - for antiquarks (result is same). | |
40492 | C...The breakdown by component is stored in the commonblock SASCOM, | |
40493 | C with elements as above. | |
40494 | C XPVMD : rho, omega, phi VMD part only of output. | |
40495 | C XPANL : d, u, s anomalous part only of output. | |
40496 | C XPANH : c, b anomalous part only of output. | |
40497 | C XPBEH : c, b Bethe-Heitler part only of output. | |
40498 | C XPDIR : Cgamma (direct contribution) part only of output. | |
40499 | C...The above arrays do not distinguish valence and sea contributions, | |
40500 | C...although this information is available internally. The additional | |
40501 | C...commonblock SASVAL provides the valence part only of the above | |
40502 | C...distributions. Array names VXPVMD, VXPANL and VXPANH correspond | |
40503 | C...to XPVMD, XPANL and XPANH, while XPBEH and XPDIR are valence only | |
40504 | C...and therefore not given doubly. VXPDGM gives the sum of valence | |
40505 | C...parts, and so matches XPDFGM. The difference, i.e. XPVMD-VXPVMD | |
40506 | C...and so on, gives the sea part only. | |
40507 | C*********************************************************************** | |
40508 | ||
40509 | SUBROUTINE PHO_SASGAM(ISET,X,Q2,P2,IP2,F2GM,XPDFGM) | |
40510 | C...Purpose: to construct the F2 and parton distributions of the photon | |
40511 | C...by summing homogeneous (VMD) and inhomogeneous (anomalous) terms. | |
40512 | C...For F2, c and b are included by the Bethe-Heitler formula; | |
40513 | C...in the 'MSbar' scheme additionally a Cgamma term is added. | |
40514 | SAVE | |
40515 | DIMENSION XPDFGM(-6:6) | |
40516 | ||
40517 | C input/output channels | |
40518 | INTEGER LI,LO | |
40519 | COMMON /POINOU/ LI,LO | |
40520 | ||
40521 | COMMON/SASCOM/XPVMD(-6:6),XPANL(-6:6),XPANH(-6:6),XPBEH(-6:6), | |
40522 | &XPDIR(-6:6) | |
40523 | COMMON/SASVAL/VXPVMD(-6:6),VXPANL(-6:6),VXPANH(-6:6),VXPDGM(-6:6) | |
454792a9 | 40524 | CPH SAVE /SASCOM/,/SASVAL/ |
9aaba0d6 | 40525 | |
40526 | C...Temporary array. | |
40527 | DIMENSION XPGA(-6:6), VXPGA(-6:6) | |
40528 | C...Charm and bottom masses (low to compensate for J/psi etc.). | |
40529 | DATA PMC/1.3/, PMB/4.6/ | |
40530 | C...alpha_em and alpha_em/(2*pi). | |
40531 | DATA AEM/0.007297/, AEM2PI/0.0011614/ | |
40532 | C...Lambda value for 4 flavours. | |
40533 | DATA ALAM/0.20/ | |
40534 | C...Mixture u/(u+d), = 0.5 for incoherent and = 0.8 for coherent sum. | |
40535 | DATA FRACU/0.8/ | |
40536 | C...VMD couplings f_V**2/(4*pi). | |
40537 | DATA FRHO/2.20/, FOMEGA/23.6/, FPHI/18.4/ | |
40538 | C...Masses for rho (=omega) and phi. | |
40539 | DATA PMRHO/0.770/, PMPHI/1.020/ | |
40540 | C...Number of points in integration for IP2=1. | |
40541 | DATA NSTEP/100/ | |
40542 | ||
40543 | C...Reset output. | |
40544 | F2GM=0. | |
40545 | DO 100 KFL=-6,6 | |
40546 | XPDFGM(KFL)=0. | |
40547 | XPVMD(KFL)=0. | |
40548 | XPANL(KFL)=0. | |
40549 | XPANH(KFL)=0. | |
40550 | XPBEH(KFL)=0. | |
40551 | XPDIR(KFL)=0. | |
40552 | VXPVMD(KFL)=0. | |
40553 | VXPANL(KFL)=0. | |
40554 | VXPANH(KFL)=0. | |
40555 | VXPDGM(KFL)=0. | |
40556 | 100 CONTINUE | |
40557 | ||
40558 | C...Check that input sensible. | |
40559 | IF(ISET.LE.0.OR.ISET.GE.5) THEN | |
40560 | WRITE(LO,*) ' FATAL ERROR: SaSgam called for unknown set' | |
40561 | WRITE(LO,*) ' ISET = ',ISET | |
40562 | STOP | |
40563 | ENDIF | |
40564 | IF(X.LE.0..OR.X.GT.1.) THEN | |
40565 | WRITE(LO,*) ' FATAL ERROR: SaSgam called for unphysical x' | |
40566 | WRITE(LO,*) ' X = ',X | |
40567 | STOP | |
40568 | ENDIF | |
40569 | ||
40570 | C...Set Q0 cut-off parameter as function of set used. | |
40571 | IF(ISET.LE.2) THEN | |
40572 | Q0=0.6 | |
40573 | ELSE | |
40574 | Q0=2. | |
40575 | ENDIF | |
40576 | Q02=Q0**2 | |
40577 | ||
40578 | C...Scale choice for off-shell photon; common factors. | |
40579 | Q2A=Q2 | |
40580 | FACNOR=1. | |
40581 | IF(IP2.EQ.1) THEN | |
40582 | P2MX=P2+Q02 | |
40583 | Q2A=Q2+P2*Q02/MAX(Q02,Q2) | |
40584 | FACNOR=LOG(Q2/Q02)/NSTEP | |
40585 | ELSEIF(IP2.EQ.2) THEN | |
40586 | P2MX=MAX(P2,Q02) | |
40587 | ELSEIF(IP2.EQ.3) THEN | |
40588 | P2MX=P2+Q02 | |
40589 | Q2A=Q2+P2*Q02/MAX(Q02,Q2) | |
40590 | ELSEIF(IP2.EQ.4) THEN | |
40591 | P2MX=Q2*(Q02+P2)/(Q2+P2)*EXP(P2*(Q2-Q02)/ | |
40592 | & ((Q2+P2)*(Q02+P2))) | |
40593 | ELSEIF(IP2.EQ.5) THEN | |
40594 | P2MXA=Q2*(Q02+P2)/(Q2+P2)*EXP(P2*(Q2-Q02)/ | |
40595 | & ((Q2+P2)*(Q02+P2))) | |
40596 | P2MX=Q0*SQRT(P2MXA) | |
40597 | FACNOR=LOG(Q2/P2MXA)/LOG(Q2/P2MX) | |
40598 | ELSEIF(IP2.EQ.6) THEN | |
40599 | P2MX=Q2*(Q02+P2)/(Q2+P2)*EXP(P2*(Q2-Q02)/ | |
40600 | & ((Q2+P2)*(Q02+P2))) | |
40601 | P2MX=MAX(0.,1.-P2/Q2)*P2MX+MIN(1.,P2/Q2)*MAX(P2,Q02) | |
40602 | ELSE | |
40603 | P2MXA=Q2*(Q02+P2)/(Q2+P2)*EXP(P2*(Q2-Q02)/ | |
40604 | & ((Q2+P2)*(Q02+P2))) | |
40605 | P2MX=Q0*SQRT(P2MXA) | |
40606 | P2MXB=P2MX | |
40607 | P2MX=MAX(0.,1.-P2/Q2)*P2MX+MIN(1.,P2/Q2)*MAX(P2,Q02) | |
40608 | P2MXB=MAX(0.,1.-P2/Q2)*P2MXB+MIN(1.,P2/Q2)*P2MXA | |
40609 | FACNOR=LOG(Q2/P2MXA)/LOG(Q2/P2MXB) | |
40610 | ENDIF | |
40611 | ||
40612 | C...Call VMD parametrization for d quark and use to give rho, omega, | |
40613 | C...phi. Note dipole dampening for off-shell photon. | |
40614 | CALL PHO_SASVMD(ISET,1,X,Q2A,P2MX,ALAM,XPGA,VXPGA) | |
40615 | XFVAL=VXPGA(1) | |
40616 | XPGA(1)=XPGA(2) | |
40617 | XPGA(-1)=XPGA(-2) | |
40618 | FACUD=AEM*(1./FRHO+1./FOMEGA)*(PMRHO**2/(PMRHO**2+P2))**2 | |
40619 | FACS=AEM*(1./FPHI)*(PMPHI**2/(PMPHI**2+P2))**2 | |
40620 | DO 110 KFL=-5,5 | |
40621 | XPVMD(KFL)=(FACUD+FACS)*XPGA(KFL) | |
40622 | 110 CONTINUE | |
40623 | XPVMD(1)=XPVMD(1)+(1.-FRACU)*FACUD*XFVAL | |
40624 | XPVMD(2)=XPVMD(2)+FRACU*FACUD*XFVAL | |
40625 | XPVMD(3)=XPVMD(3)+FACS*XFVAL | |
40626 | XPVMD(-1)=XPVMD(-1)+(1.-FRACU)*FACUD*XFVAL | |
40627 | XPVMD(-2)=XPVMD(-2)+FRACU*FACUD*XFVAL | |
40628 | XPVMD(-3)=XPVMD(-3)+FACS*XFVAL | |
40629 | VXPVMD(1)=(1.-FRACU)*FACUD*XFVAL | |
40630 | VXPVMD(2)=FRACU*FACUD*XFVAL | |
40631 | VXPVMD(3)=FACS*XFVAL | |
40632 | VXPVMD(-1)=(1.-FRACU)*FACUD*XFVAL | |
40633 | VXPVMD(-2)=FRACU*FACUD*XFVAL | |
40634 | VXPVMD(-3)=FACS*XFVAL | |
40635 | ||
40636 | IF(IP2.NE.1) THEN | |
40637 | C...Anomalous parametrizations for different strategies | |
40638 | C...for off-shell photons; except full integration. | |
40639 | ||
40640 | C...Call anomalous parametrization for d + u + s. | |
40641 | CALL PHO_SASANO(-3,X,Q2A,P2MX,ALAM,XPGA,VXPGA) | |
40642 | DO 120 KFL=-5,5 | |
40643 | XPANL(KFL)=FACNOR*XPGA(KFL) | |
40644 | VXPANL(KFL)=FACNOR*VXPGA(KFL) | |
40645 | 120 CONTINUE | |
40646 | ||
40647 | C...Call anomalous parametrization for c and b. | |
40648 | CALL PHO_SASANO(4,X,Q2A,P2MX,ALAM,XPGA,VXPGA) | |
40649 | DO 130 KFL=-5,5 | |
40650 | XPANH(KFL)=FACNOR*XPGA(KFL) | |
40651 | VXPANH(KFL)=FACNOR*VXPGA(KFL) | |
40652 | 130 CONTINUE | |
40653 | CALL PHO_SASANO(5,X,Q2A,P2MX,ALAM,XPGA,VXPGA) | |
40654 | DO 140 KFL=-5,5 | |
40655 | XPANH(KFL)=XPANH(KFL)+FACNOR*XPGA(KFL) | |
40656 | VXPANH(KFL)=VXPANH(KFL)+FACNOR*VXPGA(KFL) | |
40657 | 140 CONTINUE | |
40658 | ||
40659 | ELSE | |
40660 | C...Special option: loop over flavours and integrate over k2. | |
40661 | DO 170 KF=1,5 | |
40662 | DO 160 ISTEP=1,NSTEP | |
40663 | Q2STEP=Q02*(Q2/Q02)**((ISTEP-0.5)/NSTEP) | |
40664 | IF((KF.EQ.4.AND.Q2STEP.LT.PMC**2).OR. | |
40665 | & (KF.EQ.5.AND.Q2STEP.LT.PMB**2)) GOTO 160 | |
40666 | CALL PHO_SASVMD(0,KF,X,Q2,Q2STEP,ALAM,XPGA,VXPGA) | |
40667 | FACQ=AEM2PI*(Q2STEP/(Q2STEP+P2))**2*FACNOR | |
40668 | IF(MOD(KF,2).EQ.0) FACQ=FACQ*(8./9.) | |
40669 | IF(MOD(KF,2).EQ.1) FACQ=FACQ*(2./9.) | |
40670 | DO 150 KFL=-5,5 | |
40671 | IF(KF.LE.3) XPANL(KFL)=XPANL(KFL)+FACQ*XPGA(KFL) | |
40672 | IF(KF.GE.4) XPANH(KFL)=XPANH(KFL)+FACQ*XPGA(KFL) | |
40673 | IF(KF.LE.3) VXPANL(KFL)=VXPANL(KFL)+FACQ*VXPGA(KFL) | |
40674 | IF(KF.GE.4) VXPANH(KFL)=VXPANH(KFL)+FACQ*VXPGA(KFL) | |
40675 | 150 CONTINUE | |
40676 | 160 CONTINUE | |
40677 | 170 CONTINUE | |
40678 | ENDIF | |
40679 | ||
40680 | C...Call Bethe-Heitler term expression for charm and bottom. | |
40681 | CALL PHO_SASBEH(4,X,Q2,P2,PMC**2,XPBH) | |
40682 | XPBEH(4)=XPBH | |
40683 | XPBEH(-4)=XPBH | |
40684 | CALL PHO_SASBEH(5,X,Q2,P2,PMB**2,XPBH) | |
40685 | XPBEH(5)=XPBH | |
40686 | XPBEH(-5)=XPBH | |
40687 | ||
40688 | C...For MSbar subtraction call C^gamma term expression for d, u, s. | |
40689 | IF(ISET.EQ.2.OR.ISET.EQ.4) THEN | |
40690 | CALL PHO_SASDIR(X,Q2,P2,Q02,XPGA) | |
40691 | DO 180 KFL=-5,5 | |
40692 | XPDIR(KFL)=XPGA(KFL) | |
40693 | 180 CONTINUE | |
40694 | ENDIF | |
40695 | ||
40696 | C...Store result in output array. | |
40697 | DO 190 KFL=-5,5 | |
40698 | CHSQ=1./9. | |
40699 | IF(IABS(KFL).EQ.2.OR.IABS(KFL).EQ.4) CHSQ=4./9. | |
40700 | XPF2=XPVMD(KFL)+XPANL(KFL)+XPBEH(KFL)+XPDIR(KFL) | |
40701 | IF(KFL.NE.0) F2GM=F2GM+CHSQ*XPF2 | |
40702 | XPDFGM(KFL)=XPVMD(KFL)+XPANL(KFL)+XPANH(KFL) | |
40703 | VXPDGM(KFL)=VXPVMD(KFL)+VXPANL(KFL)+VXPANH(KFL) | |
40704 | 190 CONTINUE | |
40705 | ||
40706 | RETURN | |
40707 | END | |
40708 | ||
40709 | C********************************************************************* | |
40710 | ||
40711 | *$ CREATE PHO_SASVMD.FOR | |
40712 | *COPY PHO_SASVMD | |
40713 | CDECK ID>, PHO_SASVMD | |
40714 | SUBROUTINE PHO_SASVMD(ISET,KF,X,Q2,P2,ALAM,XPGA,VXPGA) | |
40715 | C...Purpose: to evaluate the VMD parton distributions of a photon, | |
40716 | C...evolved homogeneously from an initial scale P2 to Q2. | |
40717 | C...Does not include dipole suppression factor. | |
40718 | C...ISET is parton distribution set, see above; | |
40719 | C...additionally ISET=0 is used for the evolution of an anomalous photon | |
40720 | C...which branched at a scale P2 and then evolved homogeneously to Q2. | |
40721 | C...ALAM is the 4-flavour Lambda, which is automatically converted | |
40722 | C...to 3- and 5-flavour equivalents as needed. | |
40723 | SAVE | |
40724 | DIMENSION XPGA(-6:6), VXPGA(-6:6) | |
40725 | ||
40726 | C input/output channels | |
40727 | INTEGER LI,LO | |
40728 | COMMON /POINOU/ LI,LO | |
40729 | ||
40730 | DATA PMC/1.3/, PMB/4.6/, AEM/0.007297/, AEM2PI/0.0011614/ | |
40731 | ||
40732 | C...Reset output. | |
40733 | DO 100 KFL=-6,6 | |
40734 | XPGA(KFL)=0. | |
40735 | VXPGA(KFL)=0. | |
40736 | 100 CONTINUE | |
40737 | KFA=IABS(KF) | |
40738 | ||
40739 | C...Calculate Lambda; protect against unphysical Q2 and P2 input. | |
40740 | ALAM3=ALAM*(PMC/ALAM)**(2./27.) | |
40741 | ALAM5=ALAM*(ALAM/PMB)**(2./23.) | |
40742 | P2EFF=MAX(P2,1.2*ALAM3**2) | |
40743 | IF(KFA.EQ.4) P2EFF=MAX(P2EFF,PMC**2) | |
40744 | IF(KFA.EQ.5) P2EFF=MAX(P2EFF,PMB**2) | |
40745 | Q2EFF=MAX(Q2,P2EFF) | |
40746 | ||
40747 | C...Find number of flavours at lower and upper scale. | |
40748 | NFP=4 | |
40749 | IF(P2EFF.LT.PMC**2) NFP=3 | |
40750 | IF(P2EFF.GT.PMB**2) NFP=5 | |
40751 | NFQ=4 | |
40752 | IF(Q2EFF.LT.PMC**2) NFQ=3 | |
40753 | IF(Q2EFF.GT.PMB**2) NFQ=5 | |
40754 | ||
40755 | C...Find s as sum of 3-, 4- and 5-flavour parts. | |
40756 | S=0. | |
40757 | IF(NFP.EQ.3) THEN | |
40758 | Q2DIV=PMC**2 | |
40759 | IF(NFQ.EQ.3) Q2DIV=Q2EFF | |
40760 | S=S+(6./27.)*LOG(LOG(Q2DIV/ALAM3**2)/LOG(P2EFF/ALAM3**2)) | |
40761 | ENDIF | |
40762 | IF(NFP.LE.4.AND.NFQ.GE.4) THEN | |
40763 | P2DIV=P2EFF | |
40764 | IF(NFP.EQ.3) P2DIV=PMC**2 | |
40765 | Q2DIV=Q2EFF | |
40766 | IF(NFQ.EQ.5) Q2DIV=PMB**2 | |
40767 | S=S+(6./25.)*LOG(LOG(Q2DIV/ALAM**2)/LOG(P2DIV/ALAM**2)) | |
40768 | ENDIF | |
40769 | IF(NFQ.EQ.5) THEN | |
40770 | P2DIV=PMB**2 | |
40771 | IF(NFP.EQ.5) P2DIV=P2EFF | |
40772 | S=S+(6./23.)*LOG(LOG(Q2EFF/ALAM5**2)/LOG(P2DIV/ALAM5**2)) | |
40773 | ENDIF | |
40774 | ||
40775 | C...Calculate frequent combinations of x and s. | |
40776 | X1=1.-X | |
40777 | XL=-LOG(X) | |
40778 | S2=S**2 | |
40779 | S3=S**3 | |
40780 | S4=S**4 | |
40781 | ||
40782 | C...Evaluate homogeneous anomalous parton distributions below or | |
40783 | C...above threshold. | |
40784 | IF(ISET.EQ.0) THEN | |
40785 | IF(Q2.LE.P2.OR.(KFA.EQ.4.AND.Q2.LT.PMC**2).OR. | |
40786 | &(KFA.EQ.5.AND.Q2.LT.PMB**2)) THEN | |
40787 | XVAL = X * 1.5 * (X**2+X1**2) | |
40788 | XGLU = 0. | |
40789 | XSEA = 0. | |
40790 | ELSE | |
40791 | XVAL = (1.5/(1.-0.197*S+4.33*S2)*X**2 + (1.5+2.10*S)/ | |
40792 | & (1.+3.29*S)*X1**2 + 5.23*S/(1.+1.17*S+19.9*S3)*X*X1) * | |
40793 | & X**(1./(1.+1.5*S)) * (1.-X**2)**(2.667*S) | |
40794 | XGLU = 4.*S/(1.+4.76*S+15.2*S2+29.3*S4) * | |
40795 | & X**(-2.03*S/(1.+2.44*S)) * (X1*XL)**(1.333*S) * | |
40796 | & ((4.*X**2+7.*X+4.)*X1/3. - 2.*X*(1.+X)*XL) | |
40797 | XSEA = S2/(1.+4.54*S+8.19*S2+8.05*S3) * | |
40798 | & X**(-1.54*S/(1.+1.29*S)) * X1**(2.667*S) * | |
40799 | & ((8.-73.*X+62.*X**2)*X1/9. + (3.-8.*X**2/3.)*X*XL + | |
40800 | & (2.*X-1.)*X*XL**2) | |
40801 | ENDIF | |
40802 | ||
40803 | C...Evaluate set 1D parton distributions below or above threshold. | |
40804 | ELSEIF(ISET.EQ.1) THEN | |
40805 | IF(Q2.LE.P2.OR.(KFA.EQ.4.AND.Q2.LT.PMC**2).OR. | |
40806 | &(KFA.EQ.5.AND.Q2.LT.PMB**2)) THEN | |
40807 | XVAL = 1.294 * X**0.80 * X1**0.76 | |
40808 | XGLU = 1.273 * X**0.40 * X1**1.76 | |
40809 | XSEA = 0.100 * X1**3.76 | |
40810 | ELSE | |
40811 | XVAL = 1.294/(1.+0.252*S+3.079*S2) * X**(0.80-0.13*S) * | |
40812 | & X1**(0.76+0.667*S) * XL**(2.*S) | |
40813 | XGLU = 7.90*S/(1.+5.50*S) * EXP(-5.16*S) * | |
40814 | & X**(-1.90*S/(1.+3.60*S)) * X1**1.30 * XL**(0.50+3.*S) + | |
40815 | & 1.273 * EXP(-10.*S) * X**0.40 * X1**(1.76+3.*S) | |
40816 | XSEA = (0.1-0.397*S2+1.121*S3)/(1.+5.61*S2+5.26*S3) * | |
40817 | & X**(-7.32*S2/(1.+10.3*S2)) * | |
40818 | & X1**((3.76+15.*S+12.*S2)/(1.+4.*S)) | |
40819 | XSEA0 = 0.100 * X1**3.76 | |
40820 | ENDIF | |
40821 | ||
40822 | C...Evaluate set 1M parton distributions below or above threshold. | |
40823 | ELSEIF(ISET.EQ.2) THEN | |
40824 | IF(Q2.LE.P2.OR.(KFA.EQ.4.AND.Q2.LT.PMC**2).OR. | |
40825 | &(KFA.EQ.5.AND.Q2.LT.PMB**2)) THEN | |
40826 | XVAL = 0.8477 * X**0.51 * X1**1.37 | |
40827 | XGLU = 3.42 * X**0.255 * X1**2.37 | |
40828 | XSEA = 0. | |
40829 | ELSE | |
40830 | XVAL = 0.8477/(1.+1.37*S+2.18*S2+3.73*S3) * X**(0.51+0.21*S) | |
40831 | & * X1**1.37 * XL**(2.667*S) | |
40832 | XGLU = 24.*S/(1.+9.6*S+0.92*S2+14.34*S3) * EXP(-5.94*S) * | |
40833 | & X**((-0.013-1.80*S)/(1.+3.14*S)) * X1**(2.37+0.4*S) * | |
40834 | & XL**(0.32+3.6*S) + 3.42 * EXP(-12.*S) * X**0.255 * | |
40835 | & X1**(2.37+3.*S) | |
40836 | XSEA = 0.842*S/(1.+21.3*S-33.2*S2+229.*S3) * | |
40837 | & X**((0.13-2.90*S)/(1.+5.44*S)) * X1**(3.45+0.5*S) * | |
40838 | & XL**(2.8*S) | |
40839 | XSEA0 = 0. | |
40840 | ENDIF | |
40841 | ||
40842 | C...Evaluate set 2D parton distributions below or above threshold. | |
40843 | ELSEIF(ISET.EQ.3) THEN | |
40844 | IF(Q2.LE.P2.OR.(KFA.EQ.4.AND.Q2.LT.PMC**2).OR. | |
40845 | &(KFA.EQ.5.AND.Q2.LT.PMB**2)) THEN | |
40846 | XVAL = X**0.46 * X1**0.64 + 0.76 * X | |
40847 | XGLU = 1.925 * X1**2 | |
40848 | XSEA = 0.242 * X1**4 | |
40849 | ELSE | |
40850 | XVAL = (1.+0.186*S)/(1.-0.209*S+1.495*S2) * X**(0.46+0.25*S) | |
40851 | & * X1**((0.64+0.14*S+5.*S2)/(1.+S)) * XL**(1.9*S) + | |
40852 | & (0.76+0.4*S) * X * X1**(2.667*S) | |
40853 | XGLU = (1.925+5.55*S+147.*S2)/(1.-3.59*S+3.32*S2) * | |
40854 | & EXP(-18.67*S) * X**((-5.81*S-5.34*S2)/(1.+29.*S-4.26*S2)) | |
40855 | & * X1**((2.-5.9*S)/(1.+1.7*S)) * XL**(9.3*S/(1.+1.7*S)) | |
40856 | XSEA = (0.242-0.252*S+1.19*S2)/(1.-0.607*S+21.95*S2) * | |
40857 | & X**(-12.1*S2/(1.+2.62*S+16.7*S2)) * X1**4 * XL**S | |
40858 | XSEA0 = 0.242 * X1**4 | |
40859 | ENDIF | |
40860 | ||
40861 | C...Evaluate set 2M parton distributions below or above threshold. | |
40862 | ELSEIF(ISET.EQ.4) THEN | |
40863 | IF(Q2.LE.P2.OR.(KFA.EQ.4.AND.Q2.LT.PMC**2).OR. | |
40864 | &(KFA.EQ.5.AND.Q2.LT.PMB**2)) THEN | |
40865 | XVAL = 1.168 * X**0.50 * X1**2.60 + 0.965 * X | |
40866 | XGLU = 1.808 * X1**2 | |
40867 | XSEA = 0.209 * X1**4 | |
40868 | ELSE | |
40869 | XVAL = (1.168+1.771*S+29.35*S2) * EXP(-5.776*S) * | |
40870 | & X**((0.5+0.208*S)/(1.-0.794*S+1.516*S2)) * | |
40871 | & X1**((2.6+7.6*S)/(1.+5.*S)) * XL**(5.15*S/(1.+2.*S)) + | |
40872 | & (0.965+22.35*S)/(1.+18.4*S) * X * X1**(2.667*S) | |
40873 | XGLU = (1.808+29.9*S)/(1.+26.4*S) * EXP(-5.28*S) * | |
40874 | & X**((-5.35*S-10.11*S2)/(1.+31.71*S)) * | |
40875 | & X1**((2.-7.3*S+4.*S2)/(1.+2.5*S)) * | |
40876 | & XL**(10.9*S/(1.+2.5*S)) | |
40877 | XSEA = (0.209+0.644*S2)/(1.+0.319*S+17.6*S2) * | |
40878 | & X**((-0.373*S-7.71*S2)/(1.+0.815*S+11.0*S2)) * | |
40879 | & X1**(4.+S) * XL**(0.45*S) | |
40880 | XSEA0 = 0.209 * X1**4 | |
40881 | ENDIF | |
40882 | ENDIF | |
40883 | ||
40884 | C...Threshold factors for c and b sea. | |
40885 | SLL=LOG(LOG(Q2EFF/ALAM**2)/LOG(P2EFF/ALAM**2)) | |
40886 | XCHM=0. | |
40887 | IF(Q2.GT.PMC**2.AND.Q2.GT.1.001*P2EFF) THEN | |
40888 | SCH=MAX(0.,LOG(LOG(PMC**2/ALAM**2)/LOG(P2EFF/ALAM**2))) | |
40889 | IF(ISET.EQ.0) THEN | |
40890 | XCHM=XSEA*(1.-(SCH/SLL)**2) | |
40891 | ELSE | |
40892 | XCHM=MAX(0.,XSEA-XSEA0*X1**(2.667*S))*(1.-SCH/SLL) | |
40893 | ENDIF | |
40894 | ENDIF | |
40895 | XBOT=0. | |
40896 | IF(Q2.GT.PMB**2.AND.Q2.GT.1.001*P2EFF) THEN | |
40897 | SBT=MAX(0.,LOG(LOG(PMB**2/ALAM**2)/LOG(P2EFF/ALAM**2))) | |
40898 | IF(ISET.EQ.0) THEN | |
40899 | XBOT=XSEA*(1.-(SBT/SLL)**2) | |
40900 | ELSE | |
40901 | XBOT=MAX(0.,XSEA-XSEA0*X1**(2.667*S))*(1.-SBT/SLL) | |
40902 | ENDIF | |
40903 | ENDIF | |
40904 | ||
40905 | C...Fill parton distributions. | |
40906 | XPGA(0)=XGLU | |
40907 | XPGA(1)=XSEA | |
40908 | XPGA(2)=XSEA | |
40909 | XPGA(3)=XSEA | |
40910 | XPGA(4)=XCHM | |
40911 | XPGA(5)=XBOT | |
40912 | XPGA(KFA)=XPGA(KFA)+XVAL | |
40913 | DO 110 KFL=1,5 | |
40914 | XPGA(-KFL)=XPGA(KFL) | |
40915 | 110 CONTINUE | |
40916 | VXPGA(KFA)=XVAL | |
40917 | VXPGA(-KFA)=XVAL | |
40918 | ||
40919 | RETURN | |
40920 | END | |
40921 | ||
40922 | C********************************************************************* | |
40923 | ||
40924 | *$ CREATE PHO_SASANO.FOR | |
40925 | *COPY PHO_SASANO | |
40926 | CDECK ID>, PHO_SASANO | |
40927 | SUBROUTINE PHO_SASANO(KF,X,Q2,P2,ALAM,XPGA,VXPGA) | |
40928 | C...Purpose: to evaluate the parton distributions of the anomalous | |
40929 | C...photon, inhomogeneously evolved from a scale P2 (where it vanishes) | |
40930 | C...to Q2. | |
40931 | C...KF=0 gives the sum over (up to) 5 flavours, | |
40932 | C...KF<0 limits to flavours up to abs(KF), | |
40933 | C...KF>0 is for flavour KF only. | |
40934 | C...ALAM is the 4-flavour Lambda, which is automatically converted | |
40935 | C...to 3- and 5-flavour equivalents as needed. | |
40936 | SAVE | |
40937 | ||
40938 | C input/output channels | |
40939 | INTEGER LI,LO | |
40940 | COMMON /POINOU/ LI,LO | |
40941 | ||
40942 | DIMENSION XPGA(-6:6), VXPGA(-6:6), ALAMSQ(3:5) | |
40943 | DATA PMC/1.3/, PMB/4.6/, AEM/0.007297/, AEM2PI/0.0011614/ | |
40944 | ||
40945 | C...Reset output. | |
40946 | DO 100 KFL=-6,6 | |
40947 | XPGA(KFL)=0. | |
40948 | VXPGA(KFL)=0. | |
40949 | 100 CONTINUE | |
40950 | IF(Q2.LE.P2) RETURN | |
40951 | KFA=IABS(KF) | |
40952 | ||
40953 | C...Calculate Lambda; protect against unphysical Q2 and P2 input. | |
40954 | ALAMSQ(3)=(ALAM*(PMC/ALAM)**(2./27.))**2 | |
40955 | ALAMSQ(4)=ALAM**2 | |
40956 | ALAMSQ(5)=(ALAM*(ALAM/PMB)**(2./23.))**2 | |
40957 | P2EFF=MAX(P2,1.2*ALAMSQ(3)) | |
40958 | IF(KF.EQ.4) P2EFF=MAX(P2EFF,PMC**2) | |
40959 | IF(KF.EQ.5) P2EFF=MAX(P2EFF,PMB**2) | |
40960 | Q2EFF=MAX(Q2,P2EFF) | |
40961 | XL=-LOG(X) | |
40962 | ||
40963 | C...Find number of flavours at lower and upper scale. | |
40964 | NFP=4 | |
40965 | IF(P2EFF.LT.PMC**2) NFP=3 | |
40966 | IF(P2EFF.GT.PMB**2) NFP=5 | |
40967 | NFQ=4 | |
40968 | IF(Q2EFF.LT.PMC**2) NFQ=3 | |
40969 | IF(Q2EFF.GT.PMB**2) NFQ=5 | |
40970 | ||
40971 | C...Define range of flavour loop. | |
40972 | IF(KF.EQ.0) THEN | |
40973 | KFLMN=1 | |
40974 | KFLMX=5 | |
40975 | ELSEIF(KF.LT.0) THEN | |
40976 | KFLMN=1 | |
40977 | KFLMX=KFA | |
40978 | ELSE | |
40979 | KFLMN=KFA | |
40980 | KFLMX=KFA | |
40981 | ENDIF | |
40982 | ||
40983 | C...Loop over flavours the photon can branch into. | |
40984 | DO 110 KFL=KFLMN,KFLMX | |
40985 | ||
40986 | C...Light flavours: calculate t range and (approximate) s range. | |
40987 | IF(KFL.LE.3.AND.(KFL.EQ.1.OR.KFL.EQ.KF)) THEN | |
40988 | TDIFF=LOG(Q2EFF/P2EFF) | |
40989 | S=(6./(33.-2.*NFQ))*LOG(LOG(Q2EFF/ALAMSQ(NFQ))/ | |
40990 | & LOG(P2EFF/ALAMSQ(NFQ))) | |
40991 | IF(NFQ.GT.NFP) THEN | |
40992 | Q2DIV=PMB**2 | |
40993 | IF(NFQ.EQ.4) Q2DIV=PMC**2 | |
40994 | SNFQ=(6./(33.-2.*NFQ))*LOG(LOG(Q2DIV/ALAMSQ(NFQ))/ | |
40995 | & LOG(P2EFF/ALAMSQ(NFQ))) | |
40996 | SNFP=(6./(33.-2.*(NFQ-1)))*LOG(LOG(Q2DIV/ALAMSQ(NFQ-1))/ | |
40997 | & LOG(P2EFF/ALAMSQ(NFQ-1))) | |
40998 | S=S+(LOG(Q2DIV/P2EFF)/LOG(Q2EFF/P2EFF))*(SNFP-SNFQ) | |
40999 | ENDIF | |
41000 | IF(NFQ.EQ.5.AND.NFP.EQ.3) THEN | |
41001 | Q2DIV=PMC**2 | |
41002 | SNF4=(6./(33.-2.*4))*LOG(LOG(Q2DIV/ALAMSQ(4))/ | |
41003 | & LOG(P2EFF/ALAMSQ(4))) | |
41004 | SNF3=(6./(33.-2.*3))*LOG(LOG(Q2DIV/ALAMSQ(3))/ | |
41005 | & LOG(P2EFF/ALAMSQ(3))) | |
41006 | S=S+(LOG(Q2DIV/P2EFF)/LOG(Q2EFF/P2EFF))*(SNF3-SNF4) | |
41007 | ENDIF | |
41008 | ||
41009 | C...u and s quark do not need a separate treatment when d has been done. | |
41010 | ELSEIF(KFL.EQ.2.OR.KFL.EQ.3) THEN | |
41011 | ||
41012 | C...Charm: as above, but only include range above c threshold. | |
41013 | ELSEIF(KFL.EQ.4) THEN | |
41014 | IF(Q2.LE.PMC**2) GOTO 110 | |
41015 | P2EFF=MAX(P2EFF,PMC**2) | |
41016 | Q2EFF=MAX(Q2EFF,P2EFF) | |
41017 | TDIFF=LOG(Q2EFF/P2EFF) | |
41018 | S=(6./(33.-2.*NFQ))*LOG(LOG(Q2EFF/ALAMSQ(NFQ))/ | |
41019 | & LOG(P2EFF/ALAMSQ(NFQ))) | |
41020 | IF(NFQ.EQ.5.AND.NFP.EQ.4) THEN | |
41021 | Q2DIV=PMB**2 | |
41022 | SNFQ=(6./(33.-2.*NFQ))*LOG(LOG(Q2DIV/ALAMSQ(NFQ))/ | |
41023 | & LOG(P2EFF/ALAMSQ(NFQ))) | |
41024 | SNFP=(6./(33.-2.*(NFQ-1)))*LOG(LOG(Q2DIV/ALAMSQ(NFQ-1))/ | |
41025 | & LOG(P2EFF/ALAMSQ(NFQ-1))) | |
41026 | S=S+(LOG(Q2DIV/P2EFF)/LOG(Q2EFF/P2EFF))*(SNFP-SNFQ) | |
41027 | ENDIF | |
41028 | ||
41029 | C...Bottom: as above, but only include range above b threshold. | |
41030 | ELSEIF(KFL.EQ.5) THEN | |
41031 | IF(Q2.LE.PMB**2) GOTO 110 | |
41032 | P2EFF=MAX(P2EFF,PMB**2) | |
41033 | Q2EFF=MAX(Q2,P2EFF) | |
41034 | TDIFF=LOG(Q2EFF/P2EFF) | |
41035 | S=(6./(33.-2.*NFQ))*LOG(LOG(Q2EFF/ALAMSQ(NFQ))/ | |
41036 | & LOG(P2EFF/ALAMSQ(NFQ))) | |
41037 | ENDIF | |
41038 | ||
41039 | C...Evaluate flavour-dependent prefactor (charge^2 etc.). | |
41040 | CHSQ=1./9. | |
41041 | IF(KFL.EQ.2.OR.KFL.EQ.4) CHSQ=4./9. | |
41042 | FAC=AEM2PI*2.*CHSQ*TDIFF | |
41043 | ||
41044 | C...Evaluate parton distributions (normalized to unit momentum sum). | |
41045 | IF(KFL.EQ.1.OR.KFL.EQ.4.OR.KFL.EQ.5.OR.KFL.EQ.KF) THEN | |
41046 | XVAL= ((1.5+2.49*S+26.9*S**2)/(1.+32.3*S**2)*X**2 + | |
41047 | & (1.5-0.49*S+7.83*S**2)/(1.+7.68*S**2)*(1.-X)**2 + | |
41048 | & 1.5*S/(1.-3.2*S+7.*S**2)*X*(1.-X)) * | |
41049 | & X**(1./(1.+0.58*S)) * (1.-X**2)**(2.5*S/(1.+10.*S)) | |
41050 | XGLU= 2.*S/(1.+4.*S+7.*S**2) * | |
41051 | & X**(-1.67*S/(1.+2.*S)) * (1.-X**2)**(1.2*S) * | |
41052 | & ((4.*X**2+7.*X+4.)*(1.-X)/3. - 2.*X*(1.+X)*XL) | |
41053 | XSEA= 0.333*S**2/(1.+4.90*S+4.69*S**2+21.4*S**3) * | |
41054 | & X**(-1.18*S/(1.+1.22*S)) * (1.-X)**(1.2*S) * | |
41055 | & ((8.-73.*X+62.*X**2)*(1.-X)/9. + (3.-8.*X**2/3.)*X*XL + | |
41056 | & (2.*X-1.)*X*XL**2) | |
41057 | ||
41058 | C...Threshold factors for c and b sea. | |
41059 | SLL=LOG(LOG(Q2EFF/ALAM**2)/LOG(P2EFF/ALAM**2)) | |
41060 | XCHM=0. | |
41061 | IF(Q2.GT.PMC**2.AND.Q2.GT.1.001*P2EFF) THEN | |
41062 | SCH=MAX(0.,LOG(LOG(PMC**2/ALAM**2)/LOG(P2EFF/ALAM**2))) | |
41063 | XCHM=XSEA*(1.-(SCH/SLL)**3) | |
41064 | ENDIF | |
41065 | XBOT=0. | |
41066 | IF(Q2.GT.PMB**2.AND.Q2.GT.1.001*P2EFF) THEN | |
41067 | SBT=MAX(0.,LOG(LOG(PMB**2/ALAM**2)/LOG(P2EFF/ALAM**2))) | |
41068 | XBOT=XSEA*(1.-(SBT/SLL)**3) | |
41069 | ENDIF | |
41070 | ENDIF | |
41071 | ||
41072 | C...Add contribution of each valence flavour. | |
41073 | XPGA(0)=XPGA(0)+FAC*XGLU | |
41074 | XPGA(1)=XPGA(1)+FAC*XSEA | |
41075 | XPGA(2)=XPGA(2)+FAC*XSEA | |
41076 | XPGA(3)=XPGA(3)+FAC*XSEA | |
41077 | XPGA(4)=XPGA(4)+FAC*XCHM | |
41078 | XPGA(5)=XPGA(5)+FAC*XBOT | |
41079 | XPGA(KFL)=XPGA(KFL)+FAC*XVAL | |
41080 | VXPGA(KFL)=VXPGA(KFL)+FAC*XVAL | |
41081 | 110 CONTINUE | |
41082 | DO 120 KFL=1,5 | |
41083 | XPGA(-KFL)=XPGA(KFL) | |
41084 | VXPGA(-KFL)=VXPGA(KFL) | |
41085 | 120 CONTINUE | |
41086 | ||
41087 | END | |
41088 | ||
41089 | C********************************************************************* | |
41090 | ||
41091 | *$ CREATE PHO_SASBEH.FOR | |
41092 | *COPY PHO_SASBEH | |
41093 | CDECK ID>, PHO_SASBEH | |
41094 | SUBROUTINE PHO_SASBEH(KF,X,Q2,P2,PM2,XPBH) | |
41095 | C...Purpose: to evaluate the Bethe-Heitler cross section for | |
41096 | C...heavy flavour production. | |
41097 | SAVE | |
41098 | DATA AEM2PI/0.0011614/ | |
41099 | ||
41100 | C...Reset output. | |
41101 | XPBH=0. | |
41102 | SIGBH=0. | |
41103 | ||
41104 | C...Check kinematics limits. | |
41105 | IF(X.GE.Q2/(4.*PM2+Q2+P2)) RETURN | |
41106 | W2=Q2*(1.-X)/X-P2 | |
41107 | BETA2=1.-4.*PM2/W2 | |
41108 | IF(BETA2.LT.1E-10) RETURN | |
41109 | BETA=SQRT(BETA2) | |
41110 | RMQ=4.*PM2/Q2 | |
41111 | ||
41112 | C...Simple case: P2 = 0. | |
41113 | IF(P2.LT.1E-4) THEN | |
41114 | IF(BETA.LT.0.99) THEN | |
41115 | XBL=LOG((1.+BETA)/(1.-BETA)) | |
41116 | ELSE | |
41117 | XBL=LOG((1.+BETA)**2*W2/(4.*PM2)) | |
41118 | ENDIF | |
41119 | SIGBH=BETA*(8.*X*(1.-X)-1.-RMQ*X*(1.-X))+ | |
41120 | & XBL*(X**2+(1.-X)**2+RMQ*X*(1.-3.*X)-0.5*RMQ**2*X**2) | |
41121 | ||
41122 | C...Complicated case: P2 > 0, based on approximation of | |
41123 | C...C.T. Hill and G.G. Ross, Nucl. Phys. B148 (1979) 373 | |
41124 | ELSE | |
41125 | RPQ=1.-4.*X**2*P2/Q2 | |
41126 | IF(RPQ.GT.1E-10) THEN | |
41127 | RPBE=SQRT(RPQ*BETA2) | |
41128 | IF(RPBE.LT.0.99) THEN | |
41129 | XBL=LOG((1.+RPBE)/(1.-RPBE)) | |
41130 | XBI=2.*RPBE/(1.-RPBE**2) | |
41131 | ELSE | |
41132 | RPBESN=4.*PM2/W2+(4.*X**2*P2/Q2)*BETA2 | |
41133 | XBL=LOG((1.+RPBE)**2/RPBESN) | |
41134 | XBI=2.*RPBE/RPBESN | |
41135 | ENDIF | |
41136 | SIGBH=BETA*(6.*X*(1.-X)-1.)+ | |
41137 | & XBL*(X**2+(1.-X)**2+RMQ*X*(1.-3.*X)-0.5*RMQ**2*X**2)+ | |
41138 | & XBI*(2.*X/Q2)*(PM2*X*(2.-RMQ)-P2*X) | |
41139 | ENDIF | |
41140 | ENDIF | |
41141 | ||
41142 | C...Multiply by charge-squared etc. to get parton distribution. | |
41143 | CHSQ=1./9. | |
41144 | IF(IABS(KF).EQ.2.OR.IABS(KF).EQ.4) CHSQ=4./9. | |
41145 | XPBH=3.*CHSQ*AEM2PI*X*SIGBH | |
41146 | ||
41147 | END | |
41148 | ||
41149 | C********************************************************************* | |
41150 | ||
41151 | *$ CREATE PHO_SASDIR.FOR | |
41152 | *COPY PHO_SASDIR | |
41153 | CDECK ID>, PHO_SASDIR | |
41154 | SUBROUTINE PHO_SASDIR(X,Q2,P2,Q02,XPGA) | |
41155 | C...Purpose: to evaluate the direct contribution, i.e. the C^gamma term, | |
41156 | C...as needed in MSbar parametrizations. | |
41157 | SAVE | |
41158 | DIMENSION XPGA(-6:6) | |
41159 | DATA PMC/1.3/, PMB/4.6/, AEM2PI/0.0011614/ | |
41160 | ||
41161 | C...Reset output. | |
41162 | DO 100 KFL=-6,6 | |
41163 | XPGA(KFL)=0. | |
41164 | 100 CONTINUE | |
41165 | ||
41166 | C...Evaluate common x-dependent expression. | |
41167 | XTMP = (X**2+(1.-X)**2) * (-LOG(X)) - 1. | |
41168 | CGAM = 3.*AEM2PI*X * (XTMP*(1.+P2/(P2+Q02)) + 6.*X*(1.-X)) | |
41169 | ||
41170 | C...d, u, s part by simple charge factor. | |
41171 | XPGA(1)=(1./9.)*CGAM | |
41172 | XPGA(2)=(4./9.)*CGAM | |
41173 | XPGA(3)=(1./9.)*CGAM | |
41174 | ||
41175 | C...Also fill for antiquarks. | |
41176 | DO 110 KF=1,5 | |
41177 | XPGA(-KF)=XPGA(KF) | |
41178 | 110 CONTINUE | |
41179 | ||
41180 | END | |
41181 | ||
41182 | *$ CREATE PHO_PHGAL.FOR | |
41183 | *COPY PHO_PHGAL | |
41184 | CDECK ID>, PHO_PHGAL | |
41185 | SUBROUTINE PHO_PHGAL(X,Q2,XPDF) | |
41186 | C*********************************************************************** | |
41187 | C | |
41188 | C photon parton densities with built-in momentum sum rule and | |
41189 | C Regge-based low-x behaviour | |
41190 | C | |
41191 | C H. Abramowicz, E. Gurvich, A. Levy: Phys.Lett.B420:104-108,1998 | |
41192 | C e-Print Archive: hep-ph/9711355 | |
41193 | C | |
41194 | C code submitted by E.Gurvich, slightly modified (R.Engel, 09/1998) | |
41195 | C | |
41196 | C*********************************************************************** | |
41197 | IMPLICIT DOUBLE PRECISION(A-H,O-Z) | |
41198 | SAVE | |
41199 | ||
41200 | PARAMETER(IX=100,IQ=7,NARG=2,NFUN=4) | |
41201 | DOUBLE PRECISION | |
41202 | & XT(IX),Q2T(IQ),ARG(NARG),ENT(IX+IQ), | |
41203 | & XPV(IX,IQ,0:NFUN),XPDF(-6:6) | |
41204 | ||
41205 | DIMENSION NA(NARG) | |
41206 | ||
41207 | DATA ZEROD/0.D0/ | |
41208 | ||
41209 | C...100 x values; in (D-4,.77) log spaced (78 points) | |
41210 | C... in (.78,.995) lineary spaced (22 points) | |
41211 | DATA Q2T/4.D0,10.D0,50.D0,1.D2,1.D3,1.D4,1.D5/ | |
41212 | DATA XT/ | |
41213 | &0.1000D-03,0.1123D-03,0.1262D-03,0.1417D-03,0.1592D-03,0.1789D-03, | |
41214 | &0.2009D-03,0.2257D-03,0.2535D-03,0.2848D-03,0.3199D-03,0.3593D-03, | |
41215 | &0.4037D-03,0.4534D-03,0.5093D-03,0.5722D-03,0.6427D-03,0.7220D-03, | |
41216 | &0.8110D-03,0.9110D-03,0.1023D-02,0.1150D-02,0.1291D-02,0.1451D-02, | |
41217 | &0.1629D-02,0.1830D-02,0.2056D-02,0.2310D-02,0.2594D-02,0.2914D-02, | |
41218 | &0.3274D-02,0.3677D-02,0.4131D-02,0.4640D-02,0.5212D-02,0.5855D-02, | |
41219 | &0.6577D-02,0.7388D-02,0.8299D-02,0.9323D-02,0.1047D-01,0.1176D-01, | |
41220 | &0.1321D-01,0.1484D-01,0.1667D-01,0.1873D-01,0.2104D-01,0.2363D-01, | |
41221 | &0.2655D-01,0.2982D-01,0.3350D-01,0.3763D-01,0.4227D-01,0.4748D-01, | |
41222 | &0.5334D-01,0.5992D-01,0.6731D-01,0.7560D-01,0.8493D-01,0.9540D-01, | |
41223 | &0.1072D+00,0.1204D+00,0.1352D+00,0.1519D+00,0.1706D+00,0.1917D+00, | |
41224 | &0.2153D+00,0.2419D+00,0.2717D+00,0.3052D+00,0.3428D+00,0.3851D+00, | |
41225 | &0.4326D+00,0.4859D+00,0.5458D+00,0.6131D+00,0.6887D+00,0.7737D+00, | |
41226 | &0.7837D+00,0.7937D+00,0.8037D+00,0.8137D+00,0.8237D+00,0.8337D+00, | |
41227 | &0.8437D+00,0.8537D+00,0.8637D+00,0.8737D+00,0.8837D+00,0.8937D+00, | |
41228 | &0.9037D+00,0.9137D+00,0.9237D+00,0.9337D+00,0.9437D+00,0.9537D+00, | |
41229 | &0.9637D+00,0.9737D+00,0.9837D+00,0.9937D+00/ | |
41230 | ||
41231 | C...place for DATA blocks | |
41232 | DATA (XPV(I,1,0),I=1,100)/ | |
41233 | &0.6632D-01,0.6536D-01,0.6390D-01,0.6196D-01,0.5952D-01,0.5663D-01, | |
41234 | &0.5339D-01,0.5124D-01,0.5029D-01,0.4893D-01,0.4718D-01,0.4505D-01, | |
41235 | &0.4259D-01,0.4038D-01,0.3966D-01,0.3860D-01,0.3721D-01,0.3551D-01, | |
41236 | &0.3354D-01,0.3206D-01,0.3134D-01,0.3031D-01,0.2902D-01,0.2747D-01, | |
41237 | &0.2608D-01,0.2543D-01,0.2451D-01,0.2335D-01,0.2202D-01,0.2132D-01, | |
41238 | &0.2051D-01,0.1950D-01,0.1851D-01,0.1783D-01,0.1696D-01,0.1609D-01, | |
41239 | &0.1539D-01,0.1454D-01,0.1386D-01,0.1310D-01,0.1242D-01,0.1169D-01, | |
41240 | &0.1104D-01,0.1036D-01,0.9694D-02,0.9046D-02,0.8400D-02,0.7792D-02, | |
41241 | &0.7173D-02,0.6573D-02,0.5978D-02,0.5411D-02,0.4853D-02,0.4307D-02, | |
41242 | &0.3791D-02,0.3292D-02,0.2818D-02,0.2382D-02,0.1976D-02,0.1606D-02, | |
41243 | &0.1275D-02,0.9866D-03,0.7403D-03,0.5351D-03,0.3713D-03,0.2450D-03, | |
41244 | &0.1524D-03,0.8849D-04,0.4730D-04,0.2278D-04,0.9707D-05,0.3518D-05, | |
41245 | &0.1041D-05,0.2356D-06,0.3682D-07,0.3365D-08,0.1333D-09,0.1188D-11, | |
41246 | &0.6095D-12,0.3031D-12,0.1457D-12,0.6733D-13,0.2986D-13,0.1262D-13, | |
41247 | &0.5060D-14,0.1912D-14,0.6734D-15,0.2199D-15,0.6498D-16,0.1729D-16, | |
41248 | &0.4059D-17,0.8091D-18,0.1324D-18,0.1691D-19,0.1518D-20,0.8785D-22, | |
41249 | &0.2519D-23,0.2197D-25,0.2840D-28,0.1908D-33/ | |
41250 | DATA (XPV(I,1,1),I=1,100)/ | |
41251 | &0.5848D-03,0.5838D-03,0.5793D-03,0.5713D-03,0.5597D-03,0.5447D-03, | |
41252 | &0.5270D-03,0.5167D-03,0.5143D-03,0.5087D-03,0.4998D-03,0.4879D-03, | |
41253 | &0.4731D-03,0.4599D-03,0.4584D-03,0.4538D-03,0.4461D-03,0.4355D-03, | |
41254 | &0.4223D-03,0.4133D-03,0.4109D-03,0.4053D-03,0.3970D-03,0.3859D-03, | |
41255 | &0.3763D-03,0.3739D-03,0.3686D-03,0.3605D-03,0.3504D-03,0.3473D-03, | |
41256 | &0.3426D-03,0.3355D-03,0.3286D-03,0.3253D-03,0.3196D-03,0.3138D-03, | |
41257 | &0.3102D-03,0.3047D-03,0.3014D-03,0.2971D-03,0.2939D-03,0.2901D-03, | |
41258 | &0.2875D-03,0.2849D-03,0.2824D-03,0.2805D-03,0.2787D-03,0.2780D-03, | |
41259 | &0.2772D-03,0.2771D-03,0.2773D-03,0.2784D-03,0.2799D-03,0.2820D-03, | |
41260 | &0.2850D-03,0.2886D-03,0.2930D-03,0.2985D-03,0.3050D-03,0.3126D-03, | |
41261 | &0.3215D-03,0.3316D-03,0.3432D-03,0.3564D-03,0.3714D-03,0.3883D-03, | |
41262 | &0.4073D-03,0.4287D-03,0.4526D-03,0.4794D-03,0.5092D-03,0.5425D-03, | |
41263 | &0.5796D-03,0.6207D-03,0.6664D-03,0.7171D-03,0.7733D-03,0.8356D-03, | |
41264 | &0.8429D-03,0.8502D-03,0.8574D-03,0.8647D-03,0.8719D-03,0.8791D-03, | |
41265 | &0.8863D-03,0.8935D-03,0.9007D-03,0.9079D-03,0.9151D-03,0.9222D-03, | |
41266 | &0.9294D-03,0.9365D-03,0.9436D-03,0.9508D-03,0.9579D-03,0.9650D-03, | |
41267 | &0.9720D-03,0.9791D-03,0.9862D-03,0.9932D-03/ | |
41268 | DATA (XPV(I,1,2),I=1,100)/ | |
41269 | &0.2339D-02,0.2335D-02,0.2317D-02,0.2285D-02,0.2239D-02,0.2179D-02, | |
41270 | &0.2108D-02,0.2067D-02,0.2057D-02,0.2035D-02,0.1999D-02,0.1951D-02, | |
41271 | &0.1892D-02,0.1840D-02,0.1833D-02,0.1815D-02,0.1784D-02,0.1742D-02, | |
41272 | &0.1689D-02,0.1653D-02,0.1643D-02,0.1621D-02,0.1588D-02,0.1544D-02, | |
41273 | &0.1505D-02,0.1496D-02,0.1474D-02,0.1442D-02,0.1402D-02,0.1389D-02, | |
41274 | &0.1370D-02,0.1342D-02,0.1314D-02,0.1301D-02,0.1278D-02,0.1255D-02, | |
41275 | &0.1241D-02,0.1219D-02,0.1205D-02,0.1188D-02,0.1176D-02,0.1160D-02, | |
41276 | &0.1150D-02,0.1139D-02,0.1130D-02,0.1122D-02,0.1115D-02,0.1112D-02, | |
41277 | &0.1109D-02,0.1108D-02,0.1109D-02,0.1114D-02,0.1120D-02,0.1128D-02, | |
41278 | &0.1140D-02,0.1154D-02,0.1172D-02,0.1194D-02,0.1220D-02,0.1251D-02, | |
41279 | &0.1286D-02,0.1326D-02,0.1373D-02,0.1426D-02,0.1485D-02,0.1553D-02, | |
41280 | &0.1629D-02,0.1715D-02,0.1811D-02,0.1917D-02,0.2037D-02,0.2170D-02, | |
41281 | &0.2318D-02,0.2483D-02,0.2666D-02,0.2868D-02,0.3093D-02,0.3342D-02, | |
41282 | &0.3372D-02,0.3401D-02,0.3430D-02,0.3459D-02,0.3488D-02,0.3517D-02, | |
41283 | &0.3545D-02,0.3574D-02,0.3603D-02,0.3632D-02,0.3660D-02,0.3689D-02, | |
41284 | &0.3717D-02,0.3746D-02,0.3775D-02,0.3803D-02,0.3831D-02,0.3860D-02, | |
41285 | &0.3888D-02,0.3916D-02,0.3945D-02,0.3973D-02/ | |
41286 | DATA (XPV(I,1,3),I=1,100)/ | |
41287 | &0.1755D-03,0.1751D-03,0.1738D-03,0.1714D-03,0.1679D-03,0.1634D-03, | |
41288 | &0.1581D-03,0.1550D-03,0.1543D-03,0.1526D-03,0.1499D-03,0.1464D-03, | |
41289 | &0.1419D-03,0.1380D-03,0.1375D-03,0.1361D-03,0.1338D-03,0.1306D-03, | |
41290 | &0.1267D-03,0.1240D-03,0.1233D-03,0.1216D-03,0.1191D-03,0.1158D-03, | |
41291 | &0.1129D-03,0.1122D-03,0.1106D-03,0.1082D-03,0.1051D-03,0.1042D-03, | |
41292 | &0.1028D-03,0.1006D-03,0.9857D-04,0.9759D-04,0.9587D-04,0.9414D-04, | |
41293 | &0.9305D-04,0.9140D-04,0.9041D-04,0.8912D-04,0.8817D-04,0.8702D-04, | |
41294 | &0.8626D-04,0.8546D-04,0.8472D-04,0.8415D-04,0.8362D-04,0.8339D-04, | |
41295 | &0.8317D-04,0.8312D-04,0.8318D-04,0.8352D-04,0.8398D-04,0.8459D-04, | |
41296 | &0.8550D-04,0.8658D-04,0.8789D-04,0.8956D-04,0.9151D-04,0.9379D-04, | |
41297 | &0.9644D-04,0.9948D-04,0.1030D-03,0.1069D-03,0.1114D-03,0.1165D-03, | |
41298 | &0.1222D-03,0.1286D-03,0.1358D-03,0.1438D-03,0.1528D-03,0.1628D-03, | |
41299 | &0.1739D-03,0.1862D-03,0.1999D-03,0.2151D-03,0.2320D-03,0.2507D-03, | |
41300 | &0.2529D-03,0.2551D-03,0.2572D-03,0.2594D-03,0.2616D-03,0.2637D-03, | |
41301 | &0.2659D-03,0.2681D-03,0.2702D-03,0.2724D-03,0.2745D-03,0.2767D-03, | |
41302 | &0.2788D-03,0.2810D-03,0.2831D-03,0.2852D-03,0.2874D-03,0.2895D-03, | |
41303 | &0.2916D-03,0.2937D-03,0.2959D-03,0.2980D-03/ | |
41304 | DATA (XPV(I,1,4),I=1,100)/ | |
41305 | &0.7018D-03,0.7006D-03,0.6951D-03,0.6855D-03,0.6716D-03,0.6537D-03, | |
41306 | &0.6324D-03,0.6200D-03,0.6172D-03,0.6104D-03,0.5998D-03,0.5854D-03, | |
41307 | &0.5677D-03,0.5519D-03,0.5500D-03,0.5445D-03,0.5353D-03,0.5226D-03, | |
41308 | &0.5068D-03,0.4960D-03,0.4930D-03,0.4864D-03,0.4764D-03,0.4631D-03, | |
41309 | &0.4516D-03,0.4487D-03,0.4423D-03,0.4326D-03,0.4205D-03,0.4167D-03, | |
41310 | &0.4111D-03,0.4026D-03,0.3943D-03,0.3903D-03,0.3835D-03,0.3765D-03, | |
41311 | &0.3722D-03,0.3656D-03,0.3616D-03,0.3565D-03,0.3527D-03,0.3481D-03, | |
41312 | &0.3450D-03,0.3418D-03,0.3389D-03,0.3366D-03,0.3345D-03,0.3336D-03, | |
41313 | &0.3327D-03,0.3325D-03,0.3327D-03,0.3341D-03,0.3359D-03,0.3383D-03, | |
41314 | &0.3420D-03,0.3463D-03,0.3516D-03,0.3582D-03,0.3660D-03,0.3752D-03, | |
41315 | &0.3858D-03,0.3979D-03,0.4118D-03,0.4277D-03,0.4456D-03,0.4660D-03, | |
41316 | &0.4887D-03,0.5145D-03,0.5432D-03,0.5752D-03,0.6111D-03,0.6510D-03, | |
41317 | &0.6955D-03,0.7448D-03,0.7997D-03,0.8605D-03,0.9280D-03,0.1003D-02, | |
41318 | &0.1011D-02,0.1020D-02,0.1029D-02,0.1038D-02,0.1046D-02,0.1055D-02, | |
41319 | &0.1064D-02,0.1072D-02,0.1081D-02,0.1089D-02,0.1098D-02,0.1107D-02, | |
41320 | &0.1115D-02,0.1124D-02,0.1132D-02,0.1141D-02,0.1149D-02,0.1158D-02, | |
41321 | &0.1166D-02,0.1175D-02,0.1183D-02,0.1192D-02/ | |
41322 | DATA (XPV(I,2,0),I=1,100)/ | |
41323 | &0.1024D+00,0.1007D+00,0.9821D-01,0.9497D-01,0.9093D-01,0.8617D-01, | |
41324 | &0.8086D-01,0.7731D-01,0.7566D-01,0.7338D-01,0.7048D-01,0.6700D-01, | |
41325 | &0.6300D-01,0.5939D-01,0.5814D-01,0.5638D-01,0.5410D-01,0.5135D-01, | |
41326 | &0.4819D-01,0.4580D-01,0.4460D-01,0.4293D-01,0.4087D-01,0.3843D-01, | |
41327 | &0.3624D-01,0.3517D-01,0.3372D-01,0.3192D-01,0.2988D-01,0.2879D-01, | |
41328 | &0.2755D-01,0.2602D-01,0.2454D-01,0.2352D-01,0.2224D-01,0.2097D-01, | |
41329 | &0.1995D-01,0.1875D-01,0.1779D-01,0.1673D-01,0.1580D-01,0.1480D-01, | |
41330 | &0.1393D-01,0.1305D-01,0.1218D-01,0.1136D-01,0.1055D-01,0.9801D-02, | |
41331 | &0.9052D-02,0.8337D-02,0.7641D-02,0.6989D-02,0.6357D-02,0.5747D-02, | |
41332 | &0.5179D-02,0.4637D-02,0.4127D-02,0.3663D-02,0.3232D-02,0.2840D-02, | |
41333 | &0.2487D-02,0.2174D-02,0.1901D-02,0.1662D-02,0.1459D-02,0.1285D-02, | |
41334 | &0.1137D-02,0.1010D-02,0.9006D-03,0.8023D-03,0.7126D-03,0.6276D-03, | |
41335 | &0.5458D-03,0.4661D-03,0.3876D-03,0.3101D-03,0.2334D-03,0.1570D-03, | |
41336 | &0.1486D-03,0.1404D-03,0.1322D-03,0.1242D-03,0.1162D-03,0.1084D-03, | |
41337 | &0.1007D-03,0.9304D-04,0.8554D-04,0.7817D-04,0.7086D-04,0.6372D-04, | |
41338 | &0.5670D-04,0.4982D-04,0.4307D-04,0.3647D-04,0.3005D-04,0.2382D-04, | |
41339 | &0.1781D-04,0.1208D-04,0.6720D-05,0.1928D-05/ | |
41340 | DATA (XPV(I,2,1),I=1,100)/ | |
41341 | &0.1449D-02,0.1433D-02,0.1407D-02,0.1370D-02,0.1324D-02,0.1268D-02, | |
41342 | &0.1204D-02,0.1163D-02,0.1147D-02,0.1123D-02,0.1089D-02,0.1048D-02, | |
41343 | &0.1000D-02,0.9567D-03,0.9446D-03,0.9250D-03,0.8981D-03,0.8642D-03, | |
41344 | &0.8244D-03,0.7951D-03,0.7821D-03,0.7623D-03,0.7362D-03,0.7043D-03, | |
41345 | &0.6759D-03,0.6640D-03,0.6459D-03,0.6223D-03,0.5945D-03,0.5817D-03, | |
41346 | &0.5660D-03,0.5455D-03,0.5256D-03,0.5132D-03,0.4963D-03,0.4794D-03, | |
41347 | &0.4669D-03,0.4510D-03,0.4394D-03,0.4261D-03,0.4151D-03,0.4031D-03, | |
41348 | &0.3934D-03,0.3838D-03,0.3747D-03,0.3666D-03,0.3591D-03,0.3533D-03, | |
41349 | &0.3477D-03,0.3433D-03,0.3397D-03,0.3376D-03,0.3364D-03,0.3361D-03, | |
41350 | &0.3375D-03,0.3399D-03,0.3437D-03,0.3492D-03,0.3562D-03,0.3648D-03, | |
41351 | &0.3751D-03,0.3871D-03,0.4009D-03,0.4167D-03,0.4344D-03,0.4543D-03, | |
41352 | &0.4760D-03,0.5003D-03,0.5268D-03,0.5558D-03,0.5876D-03,0.6226D-03, | |
41353 | &0.6610D-03,0.7035D-03,0.7509D-03,0.8041D-03,0.8638D-03,0.9294D-03, | |
41354 | &0.9367D-03,0.9440D-03,0.9511D-03,0.9581D-03,0.9648D-03,0.9714D-03, | |
41355 | &0.9776D-03,0.9836D-03,0.9891D-03,0.9942D-03,0.9987D-03,0.1003D-02, | |
41356 | &0.1006D-02,0.1008D-02,0.1008D-02,0.1007D-02,0.1004D-02,0.9977D-03, | |
41357 | &0.9868D-03,0.9681D-03,0.9347D-03,0.8678D-03/ | |
41358 | DATA (XPV(I,2,2),I=1,100)/ | |
41359 | &0.3175D-02,0.3156D-02,0.3117D-02,0.3057D-02,0.2976D-02,0.2876D-02, | |
41360 | &0.2760D-02,0.2689D-02,0.2666D-02,0.2625D-02,0.2566D-02,0.2489D-02, | |
41361 | &0.2398D-02,0.2316D-02,0.2299D-02,0.2266D-02,0.2217D-02,0.2152D-02, | |
41362 | &0.2073D-02,0.2018D-02,0.1998D-02,0.1962D-02,0.1911D-02,0.1847D-02, | |
41363 | &0.1791D-02,0.1773D-02,0.1739D-02,0.1692D-02,0.1636D-02,0.1614D-02, | |
41364 | &0.1586D-02,0.1545D-02,0.1506D-02,0.1485D-02,0.1452D-02,0.1420D-02, | |
41365 | &0.1398D-02,0.1368D-02,0.1348D-02,0.1324D-02,0.1306D-02,0.1285D-02, | |
41366 | &0.1271D-02,0.1256D-02,0.1243D-02,0.1233D-02,0.1224D-02,0.1220D-02, | |
41367 | &0.1217D-02,0.1217D-02,0.1220D-02,0.1227D-02,0.1237D-02,0.1249D-02, | |
41368 | &0.1267D-02,0.1288D-02,0.1313D-02,0.1345D-02,0.1381D-02,0.1422D-02, | |
41369 | &0.1469D-02,0.1522D-02,0.1582D-02,0.1648D-02,0.1722D-02,0.1804D-02, | |
41370 | &0.1893D-02,0.1992D-02,0.2099D-02,0.2216D-02,0.2345D-02,0.2486D-02, | |
41371 | &0.2641D-02,0.2812D-02,0.3002D-02,0.3216D-02,0.3455D-02,0.3718D-02, | |
41372 | &0.3748D-02,0.3777D-02,0.3806D-02,0.3833D-02,0.3861D-02,0.3887D-02, | |
41373 | &0.3912D-02,0.3936D-02,0.3958D-02,0.3978D-02,0.3996D-02,0.4012D-02, | |
41374 | &0.4024D-02,0.4032D-02,0.4035D-02,0.4031D-02,0.4018D-02,0.3993D-02, | |
41375 | &0.3949D-02,0.3875D-02,0.3741D-02,0.3474D-02/ | |
41376 | DATA (XPV(I,2,3),I=1,100)/ | |
41377 | &0.1046D-02,0.1031D-02,0.1008D-02,0.9768D-03,0.9381D-03,0.8923D-03, | |
41378 | &0.8410D-03,0.8074D-03,0.7928D-03,0.7720D-03,0.7450D-03,0.7121D-03, | |
41379 | &0.6741D-03,0.6398D-03,0.6287D-03,0.6123D-03,0.5906D-03,0.5640D-03, | |
41380 | &0.5332D-03,0.5101D-03,0.4988D-03,0.4827D-03,0.4624D-03,0.4380D-03, | |
41381 | &0.4161D-03,0.4059D-03,0.3914D-03,0.3732D-03,0.3524D-03,0.3416D-03, | |
41382 | &0.3290D-03,0.3133D-03,0.2981D-03,0.2878D-03,0.2747D-03,0.2616D-03, | |
41383 | &0.2515D-03,0.2392D-03,0.2296D-03,0.2191D-03,0.2100D-03,0.2004D-03, | |
41384 | &0.1923D-03,0.1842D-03,0.1764D-03,0.1694D-03,0.1627D-03,0.1571D-03, | |
41385 | &0.1517D-03,0.1469D-03,0.1427D-03,0.1394D-03,0.1367D-03,0.1345D-03, | |
41386 | &0.1333D-03,0.1327D-03,0.1329D-03,0.1340D-03,0.1360D-03,0.1387D-03, | |
41387 | &0.1424D-03,0.1469D-03,0.1522D-03,0.1584D-03,0.1654D-03,0.1733D-03, | |
41388 | &0.1819D-03,0.1915D-03,0.2019D-03,0.2132D-03,0.2257D-03,0.2396D-03, | |
41389 | &0.2553D-03,0.2737D-03,0.2956D-03,0.3227D-03,0.3570D-03,0.4009D-03, | |
41390 | &0.4064D-03,0.4119D-03,0.4175D-03,0.4231D-03,0.4287D-03,0.4344D-03, | |
41391 | &0.4400D-03,0.4457D-03,0.4512D-03,0.4567D-03,0.4621D-03,0.4673D-03, | |
41392 | &0.4723D-03,0.4769D-03,0.4811D-03,0.4848D-03,0.4875D-03,0.4891D-03, | |
41393 | &0.4888D-03,0.4853D-03,0.4756D-03,0.4518D-03/ | |
41394 | DATA (XPV(I,2,4),I=1,100)/ | |
41395 | &0.1564D-02,0.1548D-02,0.1521D-02,0.1483D-02,0.1434D-02,0.1375D-02, | |
41396 | &0.1308D-02,0.1265D-02,0.1249D-02,0.1223D-02,0.1188D-02,0.1145D-02, | |
41397 | &0.1094D-02,0.1048D-02,0.1035D-02,0.1015D-02,0.9868D-03,0.9509D-03, | |
41398 | &0.9086D-03,0.8776D-03,0.8644D-03,0.8436D-03,0.8161D-03,0.7822D-03, | |
41399 | &0.7521D-03,0.7400D-03,0.7212D-03,0.6963D-03,0.6669D-03,0.6538D-03, | |
41400 | &0.6377D-03,0.6163D-03,0.5956D-03,0.5832D-03,0.5658D-03,0.5486D-03, | |
41401 | &0.5363D-03,0.5203D-03,0.5091D-03,0.4962D-03,0.4859D-03,0.4746D-03, | |
41402 | &0.4661D-03,0.4578D-03,0.4502D-03,0.4441D-03,0.4387D-03,0.4355D-03, | |
41403 | &0.4329D-03,0.4318D-03,0.4320D-03,0.4342D-03,0.4379D-03,0.4429D-03, | |
41404 | &0.4503D-03,0.4594D-03,0.4704D-03,0.4839D-03,0.4996D-03,0.5177D-03, | |
41405 | &0.5383D-03,0.5613D-03,0.5869D-03,0.6152D-03,0.6462D-03,0.6802D-03, | |
41406 | &0.7167D-03,0.7565D-03,0.7995D-03,0.8461D-03,0.8972D-03,0.9538D-03, | |
41407 | &0.1018D-02,0.1092D-02,0.1181D-02,0.1290D-02,0.1428D-02,0.1604D-02, | |
41408 | &0.1626D-02,0.1649D-02,0.1671D-02,0.1694D-02,0.1716D-02,0.1739D-02, | |
41409 | &0.1762D-02,0.1784D-02,0.1806D-02,0.1828D-02,0.1850D-02,0.1871D-02, | |
41410 | &0.1891D-02,0.1909D-02,0.1926D-02,0.1941D-02,0.1952D-02,0.1958D-02, | |
41411 | &0.1957D-02,0.1943D-02,0.1905D-02,0.1811D-02/ | |
41412 | DATA (XPV(I,3,0),I=1,100)/ | |
41413 | &0.1761D+00,0.1728D+00,0.1680D+00,0.1619D+00,0.1544D+00,0.1456D+00, | |
41414 | &0.1358D+00,0.1292D+00,0.1260D+00,0.1218D+00,0.1165D+00,0.1101D+00, | |
41415 | &0.1029D+00,0.9643D-01,0.9409D-01,0.9087D-01,0.8680D-01,0.8192D-01, | |
41416 | &0.7638D-01,0.7217D-01,0.7000D-01,0.6708D-01,0.6352D-01,0.5934D-01, | |
41417 | &0.5561D-01,0.5375D-01,0.5129D-01,0.4829D-01,0.4491D-01,0.4309D-01, | |
41418 | &0.4104D-01,0.3857D-01,0.3618D-01,0.3454D-01,0.3252D-01,0.3053D-01, | |
41419 | &0.2896D-01,0.2712D-01,0.2565D-01,0.2407D-01,0.2268D-01,0.2123D-01, | |
41420 | &0.1997D-01,0.1870D-01,0.1748D-01,0.1634D-01,0.1523D-01,0.1422D-01, | |
41421 | &0.1321D-01,0.1227D-01,0.1137D-01,0.1053D-01,0.9723D-02,0.8952D-02, | |
41422 | &0.8241D-02,0.7563D-02,0.6926D-02,0.6345D-02,0.5801D-02,0.5298D-02, | |
41423 | &0.4833D-02,0.4407D-02,0.4017D-02,0.3657D-02,0.3327D-02,0.3021D-02, | |
41424 | &0.2735D-02,0.2469D-02,0.2217D-02,0.1976D-02,0.1746D-02,0.1522D-02, | |
41425 | &0.1307D-02,0.1098D-02,0.8959D-03,0.7002D-03,0.5112D-03,0.3292D-03, | |
41426 | &0.3097D-03,0.2906D-03,0.2718D-03,0.2534D-03,0.2354D-03,0.2178D-03, | |
41427 | &0.2005D-03,0.1836D-03,0.1672D-03,0.1511D-03,0.1354D-03,0.1203D-03, | |
41428 | &0.1055D-03,0.9128D-04,0.7756D-04,0.6440D-04,0.5185D-04,0.3998D-04, | |
41429 | &0.2891D-04,0.1876D-04,0.9776D-05,0.2464D-05/ | |
41430 | DATA (XPV(I,3,1),I=1,100)/ | |
41431 | &0.3351D-02,0.3297D-02,0.3217D-02,0.3112D-02,0.2981D-02,0.2828D-02, | |
41432 | &0.2656D-02,0.2543D-02,0.2493D-02,0.2422D-02,0.2332D-02,0.2223D-02, | |
41433 | &0.2097D-02,0.1984D-02,0.1946D-02,0.1892D-02,0.1821D-02,0.1734D-02, | |
41434 | &0.1635D-02,0.1560D-02,0.1523D-02,0.1471D-02,0.1406D-02,0.1329D-02, | |
41435 | &0.1260D-02,0.1228D-02,0.1182D-02,0.1126D-02,0.1061D-02,0.1028D-02, | |
41436 | &0.9902D-03,0.9426D-03,0.8967D-03,0.8664D-03,0.8274D-03,0.7890D-03, | |
41437 | &0.7596D-03,0.7240D-03,0.6969D-03,0.6671D-03,0.6417D-03,0.6149D-03, | |
41438 | &0.5928D-03,0.5708D-03,0.5502D-03,0.5317D-03,0.5144D-03,0.5002D-03, | |
41439 | &0.4867D-03,0.4753D-03,0.4655D-03,0.4582D-03,0.4526D-03,0.4487D-03, | |
41440 | &0.4475D-03,0.4480D-03,0.4506D-03,0.4559D-03,0.4632D-03,0.4729D-03, | |
41441 | &0.4849D-03,0.4991D-03,0.5155D-03,0.5343D-03,0.5552D-03,0.5783D-03, | |
41442 | &0.6033D-03,0.6307D-03,0.6600D-03,0.6915D-03,0.7256D-03,0.7626D-03, | |
41443 | &0.8031D-03,0.8482D-03,0.8993D-03,0.9582D-03,0.1026D-02,0.1099D-02, | |
41444 | &0.1107D-02,0.1115D-02,0.1122D-02,0.1129D-02,0.1136D-02,0.1142D-02, | |
41445 | &0.1148D-02,0.1152D-02,0.1156D-02,0.1159D-02,0.1161D-02,0.1161D-02, | |
41446 | &0.1160D-02,0.1156D-02,0.1150D-02,0.1141D-02,0.1127D-02,0.1107D-02, | |
41447 | &0.1078D-02,0.1036D-02,0.9685D-03,0.8413D-03/ | |
41448 | DATA (XPV(I,3,2),I=1,100)/ | |
41449 | &0.5039D-02,0.4982D-02,0.4889D-02,0.4761D-02,0.4597D-02,0.4401D-02, | |
41450 | &0.4179D-02,0.4036D-02,0.3979D-02,0.3893D-02,0.3777D-02,0.3634D-02, | |
41451 | &0.3466D-02,0.3315D-02,0.3273D-02,0.3206D-02,0.3114D-02,0.2997D-02, | |
41452 | &0.2860D-02,0.2760D-02,0.2717D-02,0.2650D-02,0.2562D-02,0.2454D-02, | |
41453 | &0.2359D-02,0.2321D-02,0.2262D-02,0.2184D-02,0.2092D-02,0.2052D-02, | |
41454 | &0.2003D-02,0.1938D-02,0.1875D-02,0.1839D-02,0.1787D-02,0.1736D-02, | |
41455 | &0.1700D-02,0.1653D-02,0.1622D-02,0.1585D-02,0.1557D-02,0.1526D-02, | |
41456 | &0.1504D-02,0.1483D-02,0.1464D-02,0.1450D-02,0.1438D-02,0.1433D-02, | |
41457 | &0.1430D-02,0.1432D-02,0.1438D-02,0.1450D-02,0.1466D-02,0.1487D-02, | |
41458 | &0.1515D-02,0.1547D-02,0.1585D-02,0.1631D-02,0.1683D-02,0.1742D-02, | |
41459 | &0.1808D-02,0.1880D-02,0.1960D-02,0.2048D-02,0.2142D-02,0.2245D-02, | |
41460 | &0.2354D-02,0.2471D-02,0.2596D-02,0.2729D-02,0.2872D-02,0.3025D-02, | |
41461 | &0.3193D-02,0.3378D-02,0.3587D-02,0.3827D-02,0.4100D-02,0.4397D-02, | |
41462 | &0.4429D-02,0.4461D-02,0.4490D-02,0.4519D-02,0.4545D-02,0.4570D-02, | |
41463 | &0.4592D-02,0.4611D-02,0.4627D-02,0.4639D-02,0.4646D-02,0.4647D-02, | |
41464 | &0.4642D-02,0.4628D-02,0.4604D-02,0.4566D-02,0.4510D-02,0.4431D-02, | |
41465 | &0.4317D-02,0.4147D-02,0.3877D-02,0.3370D-02/ | |
41466 | DATA (XPV(I,3,3),I=1,100)/ | |
41467 | &0.2958D-02,0.2904D-02,0.2827D-02,0.2727D-02,0.2604D-02,0.2461D-02, | |
41468 | &0.2301D-02,0.2195D-02,0.2146D-02,0.2079D-02,0.1995D-02,0.1894D-02, | |
41469 | &0.1778D-02,0.1674D-02,0.1637D-02,0.1586D-02,0.1520D-02,0.1440D-02, | |
41470 | &0.1349D-02,0.1280D-02,0.1245D-02,0.1197D-02,0.1138D-02,0.1068D-02, | |
41471 | &0.1005D-02,0.9742D-03,0.9325D-03,0.8812D-03,0.8233D-03,0.7922D-03, | |
41472 | &0.7568D-03,0.7138D-03,0.6722D-03,0.6438D-03,0.6084D-03,0.5735D-03, | |
41473 | &0.5460D-03,0.5138D-03,0.4883D-03,0.4609D-03,0.4371D-03,0.4123D-03, | |
41474 | &0.3912D-03,0.3704D-03,0.3507D-03,0.3327D-03,0.3158D-03,0.3012D-03, | |
41475 | &0.2873D-03,0.2751D-03,0.2641D-03,0.2551D-03,0.2474D-03,0.2410D-03, | |
41476 | &0.2365D-03,0.2334D-03,0.2318D-03,0.2321D-03,0.2339D-03,0.2372D-03, | |
41477 | &0.2421D-03,0.2485D-03,0.2562D-03,0.2652D-03,0.2755D-03,0.2870D-03, | |
41478 | &0.2995D-03,0.3131D-03,0.3278D-03,0.3438D-03,0.3615D-03,0.3814D-03, | |
41479 | &0.4046D-03,0.4328D-03,0.4682D-03,0.5142D-03,0.5747D-03,0.6529D-03, | |
41480 | &0.6625D-03,0.6722D-03,0.6819D-03,0.6916D-03,0.7012D-03,0.7107D-03, | |
41481 | &0.7200D-03,0.7292D-03,0.7380D-03,0.7464D-03,0.7544D-03,0.7617D-03, | |
41482 | &0.7681D-03,0.7735D-03,0.7776D-03,0.7798D-03,0.7796D-03,0.7761D-03, | |
41483 | &0.7676D-03,0.7510D-03,0.7195D-03,0.6522D-03/ | |
41484 | DATA (XPV(I,3,4),I=1,100)/ | |
41485 | &0.3464D-02,0.3410D-02,0.3329D-02,0.3222D-02,0.3090D-02,0.2933D-02, | |
41486 | &0.2758D-02,0.2643D-02,0.2593D-02,0.2521D-02,0.2430D-02,0.2318D-02, | |
41487 | &0.2190D-02,0.2075D-02,0.2037D-02,0.1982D-02,0.1910D-02,0.1821D-02, | |
41488 | &0.1720D-02,0.1643D-02,0.1607D-02,0.1554D-02,0.1489D-02,0.1410D-02, | |
41489 | &0.1340D-02,0.1308D-02,0.1262D-02,0.1205D-02,0.1140D-02,0.1108D-02, | |
41490 | &0.1070D-02,0.1023D-02,0.9772D-03,0.9482D-03,0.9103D-03,0.8732D-03, | |
41491 | &0.8458D-03,0.8121D-03,0.7877D-03,0.7607D-03,0.7388D-03,0.7157D-03, | |
41492 | &0.6981D-03,0.6812D-03,0.6662D-03,0.6540D-03,0.6438D-03,0.6377D-03, | |
41493 | &0.6331D-03,0.6316D-03,0.6326D-03,0.6376D-03,0.6453D-03,0.6560D-03, | |
41494 | &0.6708D-03,0.6887D-03,0.7102D-03,0.7361D-03,0.7656D-03,0.7991D-03, | |
41495 | &0.8365D-03,0.8777D-03,0.9226D-03,0.9714D-03,0.1024D-02,0.1080D-02, | |
41496 | &0.1138D-02,0.1201D-02,0.1267D-02,0.1338D-02,0.1415D-02,0.1501D-02, | |
41497 | &0.1599D-02,0.1717D-02,0.1863D-02,0.2051D-02,0.2296D-02,0.2612D-02, | |
41498 | &0.2650D-02,0.2689D-02,0.2729D-02,0.2767D-02,0.2806D-02,0.2844D-02, | |
41499 | &0.2882D-02,0.2919D-02,0.2954D-02,0.2988D-02,0.3020D-02,0.3049D-02, | |
41500 | &0.3075D-02,0.3097D-02,0.3114D-02,0.3123D-02,0.3122D-02,0.3108D-02, | |
41501 | &0.3074D-02,0.3008D-02,0.2881D-02,0.2614D-02/ | |
41502 | DATA (XPV(I,4,0),I=1,100)/ | |
41503 | &0.2113D+00,0.2071D+00,0.2012D+00,0.1936D+00,0.1844D+00,0.1736D+00, | |
41504 | &0.1616D+00,0.1536D+00,0.1497D+00,0.1445D+00,0.1380D+00,0.1303D+00, | |
41505 | &0.1215D+00,0.1136D+00,0.1108D+00,0.1069D+00,0.1019D+00,0.9605D-01, | |
41506 | &0.8939D-01,0.8432D-01,0.8171D-01,0.7821D-01,0.7395D-01,0.6897D-01, | |
41507 | &0.6452D-01,0.6231D-01,0.5938D-01,0.5583D-01,0.5185D-01,0.4969D-01, | |
41508 | &0.4728D-01,0.4438D-01,0.4158D-01,0.3967D-01,0.3731D-01,0.3500D-01, | |
41509 | &0.3318D-01,0.3105D-01,0.2936D-01,0.2754D-01,0.2595D-01,0.2429D-01, | |
41510 | &0.2285D-01,0.2141D-01,0.2003D-01,0.1874D-01,0.1749D-01,0.1635D-01, | |
41511 | &0.1523D-01,0.1418D-01,0.1317D-01,0.1223D-01,0.1134D-01,0.1048D-01, | |
41512 | &0.9692D-02,0.8938D-02,0.8227D-02,0.7578D-02,0.6967D-02,0.6398D-02, | |
41513 | &0.5867D-02,0.5377D-02,0.4922D-02,0.4497D-02,0.4101D-02,0.3730D-02, | |
41514 | &0.3379D-02,0.3048D-02,0.2732D-02,0.2429D-02,0.2139D-02,0.1858D-02, | |
41515 | &0.1588D-02,0.1328D-02,0.1077D-02,0.8361D-03,0.6052D-03,0.3850D-03, | |
41516 | &0.3616D-03,0.3387D-03,0.3162D-03,0.2943D-03,0.2728D-03,0.2518D-03, | |
41517 | &0.2314D-03,0.2114D-03,0.1919D-03,0.1731D-03,0.1546D-03,0.1369D-03, | |
41518 | &0.1197D-03,0.1032D-03,0.8729D-04,0.7214D-04,0.5778D-04,0.4429D-04, | |
41519 | &0.3179D-04,0.2044D-04,0.1053D-04,0.2601D-05/ | |
41520 | DATA (XPV(I,4,1),I=1,100)/ | |
41521 | &0.4299D-02,0.4223D-02,0.4115D-02,0.3974D-02,0.3799D-02,0.3595D-02, | |
41522 | &0.3367D-02,0.3216D-02,0.3148D-02,0.3054D-02,0.2934D-02,0.2790D-02, | |
41523 | &0.2625D-02,0.2476D-02,0.2426D-02,0.2353D-02,0.2260D-02,0.2147D-02, | |
41524 | &0.2018D-02,0.1920D-02,0.1871D-02,0.1804D-02,0.1720D-02,0.1620D-02, | |
41525 | &0.1532D-02,0.1489D-02,0.1431D-02,0.1359D-02,0.1277D-02,0.1234D-02, | |
41526 | &0.1185D-02,0.1125D-02,0.1067D-02,0.1028D-02,0.9791D-03,0.9308D-03, | |
41527 | &0.8936D-03,0.8491D-03,0.8150D-03,0.7777D-03,0.7459D-03,0.7125D-03, | |
41528 | &0.6849D-03,0.6575D-03,0.6318D-03,0.6088D-03,0.5872D-03,0.5693D-03, | |
41529 | &0.5524D-03,0.5380D-03,0.5254D-03,0.5159D-03,0.5084D-03,0.5028D-03, | |
41530 | &0.5003D-03,0.4998D-03,0.5017D-03,0.5066D-03,0.5139D-03,0.5237D-03, | |
41531 | &0.5360D-03,0.5508D-03,0.5679D-03,0.5875D-03,0.6093D-03,0.6334D-03, | |
41532 | &0.6593D-03,0.6876D-03,0.7177D-03,0.7500D-03,0.7848D-03,0.8225D-03, | |
41533 | &0.8639D-03,0.9103D-03,0.9634D-03,0.1025D-02,0.1097D-02,0.1174D-02, | |
41534 | &0.1183D-02,0.1191D-02,0.1199D-02,0.1206D-02,0.1212D-02,0.1219D-02, | |
41535 | &0.1224D-02,0.1229D-02,0.1232D-02,0.1235D-02,0.1236D-02,0.1235D-02, | |
41536 | &0.1232D-02,0.1227D-02,0.1219D-02,0.1207D-02,0.1190D-02,0.1167D-02, | |
41537 | &0.1133D-02,0.1085D-02,0.1009D-02,0.8680D-03/ | |
41538 | DATA (XPV(I,4,2),I=1,100)/ | |
41539 | &0.5972D-02,0.5895D-02,0.5773D-02,0.5610D-02,0.5402D-02,0.5156D-02, | |
41540 | &0.4878D-02,0.4698D-02,0.4623D-02,0.4513D-02,0.4369D-02,0.4191D-02, | |
41541 | &0.3984D-02,0.3798D-02,0.3743D-02,0.3659D-02,0.3544D-02,0.3402D-02, | |
41542 | &0.3235D-02,0.3113D-02,0.3058D-02,0.2976D-02,0.2870D-02,0.2740D-02, | |
41543 | &0.2626D-02,0.2578D-02,0.2507D-02,0.2414D-02,0.2305D-02,0.2257D-02, | |
41544 | &0.2198D-02,0.2121D-02,0.2046D-02,0.2003D-02,0.1942D-02,0.1882D-02, | |
41545 | &0.1840D-02,0.1786D-02,0.1749D-02,0.1707D-02,0.1674D-02,0.1639D-02, | |
41546 | &0.1613D-02,0.1589D-02,0.1567D-02,0.1551D-02,0.1538D-02,0.1533D-02, | |
41547 | &0.1530D-02,0.1533D-02,0.1540D-02,0.1554D-02,0.1573D-02,0.1597D-02, | |
41548 | &0.1628D-02,0.1665D-02,0.1709D-02,0.1760D-02,0.1818D-02,0.1884D-02, | |
41549 | &0.1957D-02,0.2038D-02,0.2125D-02,0.2221D-02,0.2324D-02,0.2434D-02, | |
41550 | &0.2551D-02,0.2676D-02,0.2807D-02,0.2946D-02,0.3095D-02,0.3254D-02, | |
41551 | &0.3428D-02,0.3621D-02,0.3839D-02,0.4092D-02,0.4382D-02,0.4698D-02, | |
41552 | &0.4731D-02,0.4764D-02,0.4795D-02,0.4824D-02,0.4851D-02,0.4876D-02, | |
41553 | &0.4898D-02,0.4917D-02,0.4931D-02,0.4941D-02,0.4945D-02,0.4943D-02, | |
41554 | &0.4933D-02,0.4913D-02,0.4881D-02,0.4833D-02,0.4766D-02,0.4671D-02, | |
41555 | &0.4538D-02,0.4344D-02,0.4039D-02,0.3475D-02/ | |
41556 | DATA (XPV(I,4,3),I=1,100)/ | |
41557 | &0.3908D-02,0.3834D-02,0.3728D-02,0.3592D-02,0.3425D-02,0.3231D-02, | |
41558 | &0.3015D-02,0.2871D-02,0.2804D-02,0.2714D-02,0.2600D-02,0.2464D-02, | |
41559 | &0.2309D-02,0.2169D-02,0.2119D-02,0.2050D-02,0.1962D-02,0.1855D-02, | |
41560 | &0.1735D-02,0.1643D-02,0.1596D-02,0.1532D-02,0.1453D-02,0.1361D-02, | |
41561 | &0.1278D-02,0.1237D-02,0.1183D-02,0.1116D-02,0.1040D-02,0.9992D-03, | |
41562 | &0.9531D-03,0.8972D-03,0.8434D-03,0.8065D-03,0.7608D-03,0.7159D-03, | |
41563 | &0.6806D-03,0.6392D-03,0.6067D-03,0.5717D-03,0.5414D-03,0.5098D-03, | |
41564 | &0.4831D-03,0.4567D-03,0.4317D-03,0.4090D-03,0.3877D-03,0.3693D-03, | |
41565 | &0.3517D-03,0.3363D-03,0.3224D-03,0.3109D-03,0.3010D-03,0.2928D-03, | |
41566 | &0.2869D-03,0.2826D-03,0.2801D-03,0.2799D-03,0.2814D-03,0.2848D-03, | |
41567 | &0.2899D-03,0.2967D-03,0.3051D-03,0.3151D-03,0.3263D-03,0.3390D-03, | |
41568 | &0.3528D-03,0.3678D-03,0.3841D-03,0.4018D-03,0.4214D-03,0.4437D-03, | |
41569 | &0.4700D-03,0.5022D-03,0.5431D-03,0.5965D-03,0.6670D-03,0.7574D-03, | |
41570 | &0.7684D-03,0.7795D-03,0.7905D-03,0.8015D-03,0.8124D-03,0.8230D-03, | |
41571 | &0.8335D-03,0.8436D-03,0.8533D-03,0.8624D-03,0.8708D-03,0.8784D-03, | |
41572 | &0.8849D-03,0.8901D-03,0.8934D-03,0.8945D-03,0.8925D-03,0.8863D-03, | |
41573 | &0.8739D-03,0.8517D-03,0.8113D-03,0.7282D-03/ | |
41574 | DATA (XPV(I,4,4),I=1,100)/ | |
41575 | &0.4411D-02,0.4336D-02,0.4226D-02,0.4084D-02,0.3907D-02,0.3700D-02, | |
41576 | &0.3469D-02,0.3316D-02,0.3248D-02,0.3153D-02,0.3032D-02,0.2886D-02, | |
41577 | &0.2718D-02,0.2567D-02,0.2516D-02,0.2444D-02,0.2349D-02,0.2235D-02, | |
41578 | &0.2103D-02,0.2004D-02,0.1956D-02,0.1888D-02,0.1804D-02,0.1703D-02, | |
41579 | &0.1613D-02,0.1571D-02,0.1514D-02,0.1441D-02,0.1359D-02,0.1317D-02, | |
41580 | &0.1269D-02,0.1210D-02,0.1153D-02,0.1116D-02,0.1069D-02,0.1022D-02, | |
41581 | &0.9882D-03,0.9465D-03,0.9161D-03,0.8828D-03,0.8558D-03,0.8276D-03, | |
41582 | &0.8060D-03,0.7854D-03,0.7672D-03,0.7526D-03,0.7404D-03,0.7330D-03, | |
41583 | &0.7277D-03,0.7261D-03,0.7277D-03,0.7338D-03,0.7434D-03,0.7565D-03, | |
41584 | &0.7745D-03,0.7963D-03,0.8222D-03,0.8532D-03,0.8886D-03,0.9283D-03, | |
41585 | &0.9728D-03,0.1021D-02,0.1074D-02,0.1131D-02,0.1192D-02,0.1257D-02, | |
41586 | &0.1325D-02,0.1397D-02,0.1473D-02,0.1554D-02,0.1642D-02,0.1739D-02, | |
41587 | &0.1852D-02,0.1988D-02,0.2158D-02,0.2377D-02,0.2664D-02,0.3029D-02, | |
41588 | &0.3074D-02,0.3119D-02,0.3163D-02,0.3207D-02,0.3251D-02,0.3294D-02, | |
41589 | &0.3336D-02,0.3377D-02,0.3416D-02,0.3452D-02,0.3486D-02,0.3517D-02, | |
41590 | &0.3543D-02,0.3564D-02,0.3578D-02,0.3582D-02,0.3574D-02,0.3549D-02, | |
41591 | &0.3500D-02,0.3411D-02,0.3249D-02,0.2916D-02/ | |
41592 | DATA (XPV(I,5,0),I=1,100)/ | |
41593 | &0.3395D+00,0.3321D+00,0.3219D+00,0.3090D+00,0.2933D+00,0.2751D+00, | |
41594 | &0.2550D+00,0.2414D+00,0.2348D+00,0.2261D+00,0.2153D+00,0.2025D+00, | |
41595 | &0.1881D+00,0.1751D+00,0.1704D+00,0.1640D+00,0.1559D+00,0.1464D+00, | |
41596 | &0.1357D+00,0.1276D+00,0.1233D+00,0.1178D+00,0.1110D+00,0.1032D+00, | |
41597 | &0.9616D-01,0.9268D-01,0.8813D-01,0.8262D-01,0.7648D-01,0.7317D-01, | |
41598 | &0.6948D-01,0.6506D-01,0.6083D-01,0.5795D-01,0.5442D-01,0.5097D-01, | |
41599 | &0.4827D-01,0.4513D-01,0.4265D-01,0.4000D-01,0.3769D-01,0.3529D-01, | |
41600 | &0.3322D-01,0.3117D-01,0.2920D-01,0.2737D-01,0.2561D-01,0.2402D-01, | |
41601 | &0.2245D-01,0.2098D-01,0.1958D-01,0.1829D-01,0.1704D-01,0.1585D-01, | |
41602 | &0.1476D-01,0.1370D-01,0.1270D-01,0.1178D-01,0.1090D-01,0.1007D-01, | |
41603 | &0.9286D-02,0.8547D-02,0.7848D-02,0.7182D-02,0.6551D-02,0.5949D-02, | |
41604 | &0.5372D-02,0.4823D-02,0.4298D-02,0.3794D-02,0.3314D-02,0.2852D-02, | |
41605 | &0.2413D-02,0.1995D-02,0.1599D-02,0.1223D-02,0.8693D-03,0.5397D-03, | |
41606 | &0.5052D-03,0.4716D-03,0.4388D-03,0.4068D-03,0.3757D-03,0.3454D-03, | |
41607 | &0.3160D-03,0.2875D-03,0.2599D-03,0.2332D-03,0.2073D-03,0.1825D-03, | |
41608 | &0.1587D-03,0.1359D-03,0.1142D-03,0.9370D-04,0.7445D-04,0.5655D-04, | |
41609 | &0.4018D-04,0.2553D-04,0.1296D-04,0.3149D-05/ | |
41610 | DATA (XPV(I,5,1),I=1,100)/ | |
41611 | &0.7886D-02,0.7728D-02,0.7505D-02,0.7221D-02,0.6873D-02,0.6469D-02, | |
41612 | &0.6022D-02,0.5723D-02,0.5585D-02,0.5398D-02,0.5164D-02,0.4885D-02, | |
41613 | &0.4568D-02,0.4283D-02,0.4181D-02,0.4041D-02,0.3864D-02,0.3650D-02, | |
41614 | &0.3408D-02,0.3225D-02,0.3131D-02,0.3005D-02,0.2850D-02,0.2668D-02, | |
41615 | &0.2506D-02,0.2427D-02,0.2321D-02,0.2191D-02,0.2045D-02,0.1968D-02, | |
41616 | &0.1880D-02,0.1774D-02,0.1672D-02,0.1604D-02,0.1519D-02,0.1435D-02, | |
41617 | &0.1371D-02,0.1295D-02,0.1236D-02,0.1172D-02,0.1118D-02,0.1062D-02, | |
41618 | &0.1015D-02,0.9690D-03,0.9257D-03,0.8867D-03,0.8503D-03,0.8197D-03, | |
41619 | &0.7906D-03,0.7655D-03,0.7432D-03,0.7255D-03,0.7107D-03,0.6987D-03, | |
41620 | &0.6911D-03,0.6864D-03,0.6850D-03,0.6876D-03,0.6934D-03,0.7025D-03, | |
41621 | &0.7147D-03,0.7300D-03,0.7482D-03,0.7692D-03,0.7926D-03,0.8187D-03, | |
41622 | &0.8465D-03,0.8768D-03,0.9089D-03,0.9431D-03,0.9801D-03,0.1020D-02, | |
41623 | &0.1065D-02,0.1116D-02,0.1177D-02,0.1250D-02,0.1336D-02,0.1431D-02, | |
41624 | &0.1441D-02,0.1451D-02,0.1460D-02,0.1468D-02,0.1476D-02,0.1483D-02, | |
41625 | &0.1489D-02,0.1494D-02,0.1497D-02,0.1499D-02,0.1499D-02,0.1497D-02, | |
41626 | &0.1492D-02,0.1483D-02,0.1471D-02,0.1454D-02,0.1430D-02,0.1398D-02, | |
41627 | &0.1354D-02,0.1291D-02,0.1195D-02,0.1022D-02/ | |
41628 | DATA (XPV(I,5,2),I=1,100)/ | |
41629 | &0.9523D-02,0.9362D-02,0.9127D-02,0.8821D-02,0.8442D-02,0.7997D-02, | |
41630 | &0.7501D-02,0.7174D-02,0.7029D-02,0.6828D-02,0.6569D-02,0.6258D-02, | |
41631 | &0.5901D-02,0.5579D-02,0.5475D-02,0.5323D-02,0.5125D-02,0.4884D-02, | |
41632 | &0.4606D-02,0.4399D-02,0.4301D-02,0.4162D-02,0.3986D-02,0.3776D-02, | |
41633 | &0.3590D-02,0.3508D-02,0.3391D-02,0.3242D-02,0.3073D-02,0.2992D-02, | |
41634 | &0.2897D-02,0.2777D-02,0.2663D-02,0.2592D-02,0.2499D-02,0.2408D-02, | |
41635 | &0.2344D-02,0.2263D-02,0.2207D-02,0.2144D-02,0.2095D-02,0.2043D-02, | |
41636 | &0.2005D-02,0.1970D-02,0.1939D-02,0.1917D-02,0.1898D-02,0.1891D-02, | |
41637 | &0.1887D-02,0.1891D-02,0.1901D-02,0.1921D-02,0.1948D-02,0.1981D-02, | |
41638 | &0.2025D-02,0.2076D-02,0.2134D-02,0.2204D-02,0.2281D-02,0.2367D-02, | |
41639 | &0.2463D-02,0.2566D-02,0.2678D-02,0.2798D-02,0.2925D-02,0.3060D-02, | |
41640 | &0.3199D-02,0.3347D-02,0.3500D-02,0.3659D-02,0.3827D-02,0.4007D-02, | |
41641 | &0.4203D-02,0.4424D-02,0.4679D-02,0.4981D-02,0.5336D-02,0.5723D-02, | |
41642 | &0.5764D-02,0.5803D-02,0.5840D-02,0.5875D-02,0.5906D-02,0.5934D-02, | |
41643 | &0.5959D-02,0.5978D-02,0.5992D-02,0.6000D-02,0.6000D-02,0.5991D-02, | |
41644 | &0.5971D-02,0.5938D-02,0.5890D-02,0.5821D-02,0.5726D-02,0.5597D-02, | |
41645 | &0.5419D-02,0.5166D-02,0.4781D-02,0.4089D-02/ | |
41646 | DATA (XPV(I,5,3),I=1,100)/ | |
41647 | &0.7505D-02,0.7347D-02,0.7127D-02,0.6848D-02,0.6508D-02,0.6113D-02, | |
41648 | &0.5677D-02,0.5385D-02,0.5248D-02,0.5065D-02,0.4837D-02,0.4566D-02, | |
41649 | &0.4259D-02,0.3982D-02,0.3881D-02,0.3744D-02,0.3571D-02,0.3365D-02, | |
41650 | &0.3131D-02,0.2953D-02,0.2861D-02,0.2738D-02,0.2589D-02,0.2414D-02, | |
41651 | &0.2257D-02,0.2179D-02,0.2077D-02,0.1952D-02,0.1812D-02,0.1736D-02, | |
41652 | &0.1651D-02,0.1549D-02,0.1451D-02,0.1384D-02,0.1302D-02,0.1222D-02, | |
41653 | &0.1159D-02,0.1086D-02,0.1028D-02,0.9666D-03,0.9136D-03,0.8587D-03, | |
41654 | &0.8123D-03,0.7666D-03,0.7236D-03,0.6846D-03,0.6479D-03,0.6163D-03, | |
41655 | &0.5861D-03,0.5595D-03,0.5354D-03,0.5152D-03,0.4975D-03,0.4824D-03, | |
41656 | &0.4710D-03,0.4620D-03,0.4558D-03,0.4530D-03,0.4527D-03,0.4552D-03, | |
41657 | &0.4601D-03,0.4675D-03,0.4771D-03,0.4889D-03,0.5026D-03,0.5181D-03, | |
41658 | &0.5351D-03,0.5540D-03,0.5746D-03,0.5972D-03,0.6228D-03,0.6525D-03, | |
41659 | &0.6882D-03,0.7329D-03,0.7908D-03,0.8669D-03,0.9668D-03,0.1092D-02, | |
41660 | &0.1106D-02,0.1121D-02,0.1136D-02,0.1150D-02,0.1164D-02,0.1178D-02, | |
41661 | &0.1191D-02,0.1203D-02,0.1214D-02,0.1225D-02,0.1234D-02,0.1242D-02, | |
41662 | &0.1247D-02,0.1250D-02,0.1251D-02,0.1247D-02,0.1239D-02,0.1224D-02, | |
41663 | &0.1199D-02,0.1159D-02,0.1093D-02,0.9633D-03/ | |
41664 | DATA (XPV(I,5,4),I=1,100)/ | |
41665 | &0.7997D-02,0.7838D-02,0.7615D-02,0.7329D-02,0.6980D-02,0.6573D-02, | |
41666 | &0.6123D-02,0.5823D-02,0.5684D-02,0.5497D-02,0.5261D-02,0.4981D-02, | |
41667 | &0.4662D-02,0.4375D-02,0.4274D-02,0.4134D-02,0.3955D-02,0.3741D-02, | |
41668 | &0.3497D-02,0.3313D-02,0.3221D-02,0.3095D-02,0.2940D-02,0.2758D-02, | |
41669 | &0.2596D-02,0.2518D-02,0.2414D-02,0.2285D-02,0.2140D-02,0.2065D-02, | |
41670 | &0.1981D-02,0.1877D-02,0.1779D-02,0.1715D-02,0.1634D-02,0.1555D-02, | |
41671 | &0.1497D-02,0.1427D-02,0.1376D-02,0.1320D-02,0.1276D-02,0.1229D-02, | |
41672 | &0.1194D-02,0.1161D-02,0.1131D-02,0.1108D-02,0.1089D-02,0.1077D-02, | |
41673 | &0.1069D-02,0.1067D-02,0.1070D-02,0.1080D-02,0.1095D-02,0.1116D-02, | |
41674 | &0.1144D-02,0.1178D-02,0.1218D-02,0.1265D-02,0.1318D-02,0.1378D-02, | |
41675 | &0.1444D-02,0.1516D-02,0.1594D-02,0.1677D-02,0.1764D-02,0.1858D-02, | |
41676 | &0.1954D-02,0.2056D-02,0.2162D-02,0.2275D-02,0.2398D-02,0.2536D-02, | |
41677 | &0.2696D-02,0.2890D-02,0.3134D-02,0.3450D-02,0.3859D-02,0.4365D-02, | |
41678 | &0.4425D-02,0.4485D-02,0.4544D-02,0.4602D-02,0.4658D-02,0.4713D-02, | |
41679 | &0.4765D-02,0.4815D-02,0.4861D-02,0.4903D-02,0.4940D-02,0.4970D-02, | |
41680 | &0.4993D-02,0.5007D-02,0.5008D-02,0.4994D-02,0.4961D-02,0.4900D-02, | |
41681 | &0.4801D-02,0.4642D-02,0.4373D-02,0.3853D-02/ | |
41682 | DATA (XPV(I,6,0),I=1,100)/ | |
41683 | &0.4823D+00,0.4713D+00,0.4562D+00,0.4371D+00,0.4141D+00,0.3874D+00, | |
41684 | &0.3580D+00,0.3381D+00,0.3284D+00,0.3157D+00,0.3000D+00,0.2816D+00, | |
41685 | &0.2609D+00,0.2422D+00,0.2354D+00,0.2262D+00,0.2147D+00,0.2012D+00, | |
41686 | &0.1860D+00,0.1744D+00,0.1685D+00,0.1606D+00,0.1511D+00,0.1401D+00, | |
41687 | &0.1304D+00,0.1255D+00,0.1192D+00,0.1116D+00,0.1031D+00,0.9852D-01, | |
41688 | &0.9345D-01,0.8740D-01,0.8162D-01,0.7769D-01,0.7289D-01,0.6822D-01, | |
41689 | &0.6457D-01,0.6033D-01,0.5700D-01,0.5343D-01,0.5035D-01,0.4714D-01, | |
41690 | &0.4439D-01,0.4166D-01,0.3905D-01,0.3663D-01,0.3429D-01,0.3219D-01, | |
41691 | &0.3012D-01,0.2819D-01,0.2634D-01,0.2464D-01,0.2300D-01,0.2142D-01, | |
41692 | &0.1997D-01,0.1857D-01,0.1723D-01,0.1600D-01,0.1482D-01,0.1370D-01, | |
41693 | &0.1263D-01,0.1162D-01,0.1065D-01,0.9734D-02,0.8858D-02,0.8020D-02, | |
41694 | &0.7218D-02,0.6455D-02,0.5727D-02,0.5031D-02,0.4372D-02,0.3743D-02, | |
41695 | &0.3148D-02,0.2587D-02,0.2059D-02,0.1563D-02,0.1101D-02,0.6756D-03, | |
41696 | &0.6315D-03,0.5886D-03,0.5468D-03,0.5062D-03,0.4667D-03,0.4284D-03, | |
41697 | &0.3913D-03,0.3553D-03,0.3206D-03,0.2871D-03,0.2547D-03,0.2238D-03, | |
41698 | &0.1942D-03,0.1660D-03,0.1392D-03,0.1139D-03,0.9030D-04,0.6843D-04, | |
41699 | &0.4849D-04,0.3074D-04,0.1557D-04,0.3784D-05/ | |
41700 | DATA (XPV(I,6,1),I=1,100)/ | |
41701 | &0.1205D-01,0.1178D-01,0.1142D-01,0.1096D-01,0.1041D-01,0.9763D-02, | |
41702 | &0.9053D-02,0.8577D-02,0.8354D-02,0.8057D-02,0.7688D-02,0.7251D-02, | |
41703 | &0.6756D-02,0.6310D-02,0.6149D-02,0.5929D-02,0.5654D-02,0.5325D-02, | |
41704 | &0.4953D-02,0.4670D-02,0.4526D-02,0.4332D-02,0.4097D-02,0.3822D-02, | |
41705 | &0.3577D-02,0.3456D-02,0.3297D-02,0.3102D-02,0.2885D-02,0.2769D-02, | |
41706 | &0.2639D-02,0.2483D-02,0.2333D-02,0.2232D-02,0.2107D-02,0.1985D-02, | |
41707 | &0.1891D-02,0.1781D-02,0.1696D-02,0.1604D-02,0.1526D-02,0.1445D-02, | |
41708 | &0.1377D-02,0.1310D-02,0.1248D-02,0.1192D-02,0.1139D-02,0.1094D-02, | |
41709 | &0.1052D-02,0.1015D-02,0.9816D-03,0.9544D-03,0.9311D-03,0.9114D-03, | |
41710 | &0.8975D-03,0.8872D-03,0.8810D-03,0.8801D-03,0.8830D-03,0.8899D-03, | |
41711 | &0.9007D-03,0.9151D-03,0.9330D-03,0.9541D-03,0.9781D-03,0.1005D-02, | |
41712 | &0.1034D-02,0.1065D-02,0.1099D-02,0.1135D-02,0.1174D-02,0.1217D-02, | |
41713 | &0.1266D-02,0.1323D-02,0.1392D-02,0.1478D-02,0.1581D-02,0.1696D-02, | |
41714 | &0.1708D-02,0.1720D-02,0.1731D-02,0.1741D-02,0.1751D-02,0.1759D-02, | |
41715 | &0.1766D-02,0.1772D-02,0.1776D-02,0.1778D-02,0.1778D-02,0.1775D-02, | |
41716 | &0.1769D-02,0.1759D-02,0.1744D-02,0.1723D-02,0.1695D-02,0.1657D-02, | |
41717 | &0.1604D-02,0.1530D-02,0.1417D-02,0.1218D-02/ | |
41718 | DATA (XPV(I,6,2),I=1,100)/ | |
41719 | &0.1365D-01,0.1339D-01,0.1302D-01,0.1254D-01,0.1195D-01,0.1127D-01, | |
41720 | &0.1051D-01,0.1001D-01,0.9777D-02,0.9465D-02,0.9073D-02,0.8604D-02, | |
41721 | &0.8069D-02,0.7589D-02,0.7425D-02,0.7195D-02,0.6900D-02,0.6544D-02, | |
41722 | &0.6138D-02,0.5834D-02,0.5686D-02,0.5481D-02,0.5226D-02,0.4925D-02, | |
41723 | &0.4658D-02,0.4536D-02,0.4367D-02,0.4157D-02,0.3918D-02,0.3801D-02, | |
41724 | &0.3667D-02,0.3499D-02,0.3340D-02,0.3241D-02,0.3112D-02,0.2987D-02, | |
41725 | &0.2897D-02,0.2787D-02,0.2709D-02,0.2624D-02,0.2557D-02,0.2487D-02, | |
41726 | &0.2436D-02,0.2387D-02,0.2346D-02,0.2315D-02,0.2290D-02,0.2279D-02, | |
41727 | &0.2273D-02,0.2277D-02,0.2289D-02,0.2313D-02,0.2346D-02,0.2387D-02, | |
41728 | &0.2441D-02,0.2503D-02,0.2575D-02,0.2660D-02,0.2755D-02,0.2859D-02, | |
41729 | &0.2974D-02,0.3099D-02,0.3232D-02,0.3374D-02,0.3523D-02,0.3680D-02, | |
41730 | &0.3841D-02,0.4010D-02,0.4183D-02,0.4363D-02,0.4552D-02,0.4754D-02, | |
41731 | &0.4976D-02,0.5229D-02,0.5526D-02,0.5885D-02,0.6313D-02,0.6782D-02, | |
41732 | &0.6832D-02,0.6879D-02,0.6924D-02,0.6966D-02,0.7004D-02,0.7038D-02, | |
41733 | &0.7067D-02,0.7091D-02,0.7108D-02,0.7117D-02,0.7116D-02,0.7105D-02, | |
41734 | &0.7081D-02,0.7041D-02,0.6982D-02,0.6899D-02,0.6786D-02,0.6631D-02, | |
41735 | &0.6421D-02,0.6123D-02,0.5672D-02,0.4871D-02/ | |
41736 | DATA (XPV(I,6,3),I=1,100)/ | |
41737 | &0.1167D-01,0.1141D-01,0.1105D-01,0.1060D-01,0.1005D-01,0.9414D-02, | |
41738 | &0.8715D-02,0.8245D-02,0.8024D-02,0.7730D-02,0.7367D-02,0.6937D-02, | |
41739 | &0.6451D-02,0.6013D-02,0.5853D-02,0.5637D-02,0.5366D-02,0.5044D-02, | |
41740 | &0.4680D-02,0.4403D-02,0.4259D-02,0.4069D-02,0.3839D-02,0.3571D-02, | |
41741 | &0.3331D-02,0.3212D-02,0.3055D-02,0.2866D-02,0.2654D-02,0.2540D-02, | |
41742 | &0.2413D-02,0.2260D-02,0.2114D-02,0.2014D-02,0.1892D-02,0.1773D-02, | |
41743 | &0.1680D-02,0.1572D-02,0.1488D-02,0.1398D-02,0.1320D-02,0.1240D-02, | |
41744 | &0.1173D-02,0.1106D-02,0.1044D-02,0.9874D-03,0.9342D-03,0.8881D-03, | |
41745 | &0.8442D-03,0.8052D-03,0.7698D-03,0.7399D-03,0.7134D-03,0.6903D-03, | |
41746 | &0.6722D-03,0.6574D-03,0.6463D-03,0.6397D-03,0.6365D-03,0.6368D-03, | |
41747 | &0.6405D-03,0.6473D-03,0.6570D-03,0.6695D-03,0.6844D-03,0.7019D-03, | |
41748 | &0.7213D-03,0.7431D-03,0.7673D-03,0.7943D-03,0.8253D-03,0.8617D-03, | |
41749 | &0.9063D-03,0.9627D-03,0.1036D-02,0.1133D-02,0.1259D-02,0.1412D-02, | |
41750 | &0.1430D-02,0.1448D-02,0.1465D-02,0.1482D-02,0.1499D-02,0.1514D-02, | |
41751 | &0.1529D-02,0.1543D-02,0.1556D-02,0.1567D-02,0.1576D-02,0.1583D-02, | |
41752 | &0.1587D-02,0.1588D-02,0.1586D-02,0.1578D-02,0.1563D-02,0.1539D-02, | |
41753 | &0.1504D-02,0.1448D-02,0.1358D-02,0.1189D-02/ | |
41754 | DATA (XPV(I,6,4),I=1,100)/ | |
41755 | &0.1216D-01,0.1189D-01,0.1153D-01,0.1107D-01,0.1051D-01,0.9868D-02, | |
41756 | &0.9154D-02,0.8677D-02,0.8454D-02,0.8157D-02,0.7787D-02,0.7349D-02, | |
41757 | &0.6851D-02,0.6404D-02,0.6244D-02,0.6025D-02,0.5749D-02,0.5420D-02, | |
41758 | &0.5047D-02,0.4764D-02,0.4621D-02,0.4429D-02,0.4195D-02,0.3920D-02, | |
41759 | &0.3677D-02,0.3559D-02,0.3402D-02,0.3211D-02,0.2996D-02,0.2884D-02, | |
41760 | &0.2759D-02,0.2608D-02,0.2463D-02,0.2369D-02,0.2251D-02,0.2138D-02, | |
41761 | &0.2053D-02,0.1952D-02,0.1879D-02,0.1800D-02,0.1736D-02,0.1670D-02, | |
41762 | &0.1619D-02,0.1572D-02,0.1531D-02,0.1498D-02,0.1470D-02,0.1454D-02, | |
41763 | &0.1442D-02,0.1439D-02,0.1442D-02,0.1455D-02,0.1475D-02,0.1502D-02, | |
41764 | &0.1539D-02,0.1584D-02,0.1637D-02,0.1699D-02,0.1769D-02,0.1847D-02, | |
41765 | &0.1934D-02,0.2027D-02,0.2128D-02,0.2235D-02,0.2348D-02,0.2468D-02, | |
41766 | &0.2591D-02,0.2721D-02,0.2857D-02,0.3001D-02,0.3158D-02,0.3333D-02, | |
41767 | &0.3538D-02,0.3788D-02,0.4102D-02,0.4506D-02,0.5022D-02,0.5648D-02, | |
41768 | &0.5720D-02,0.5792D-02,0.5862D-02,0.5931D-02,0.5997D-02,0.6060D-02, | |
41769 | &0.6120D-02,0.6176D-02,0.6226D-02,0.6271D-02,0.6308D-02,0.6337D-02, | |
41770 | &0.6354D-02,0.6359D-02,0.6348D-02,0.6316D-02,0.6257D-02,0.6163D-02, | |
41771 | &0.6019D-02,0.5797D-02,0.5436D-02,0.4755D-02/ | |
41772 | DATA (XPV(I,7,0),I=1,100)/ | |
41773 | &0.6367D+00,0.6216D+00,0.6010D+00,0.5752D+00,0.5440D+00,0.5081D+00, | |
41774 | &0.4686D+00,0.4418D+00,0.4287D+00,0.4116D+00,0.3907D+00,0.3662D+00, | |
41775 | &0.3385D+00,0.3137D+00,0.3045D+00,0.2923D+00,0.2772D+00,0.2594D+00, | |
41776 | &0.2393D+00,0.2241D+00,0.2163D+00,0.2060D+00,0.1936D+00,0.1792D+00, | |
41777 | &0.1665D+00,0.1602D+00,0.1520D+00,0.1421D+00,0.1311D+00,0.1252D+00, | |
41778 | &0.1187D+00,0.1109D+00,0.1035D+00,0.9842D-01,0.9228D-01,0.8630D-01, | |
41779 | &0.8164D-01,0.7624D-01,0.7200D-01,0.6747D-01,0.6355D-01,0.5948D-01, | |
41780 | &0.5601D-01,0.5255D-01,0.4926D-01,0.4620D-01,0.4326D-01,0.4061D-01, | |
41781 | &0.3801D-01,0.3557D-01,0.3324D-01,0.3109D-01,0.2903D-01,0.2705D-01, | |
41782 | &0.2521D-01,0.2344D-01,0.2175D-01,0.2018D-01,0.1868D-01,0.1725D-01, | |
41783 | &0.1589D-01,0.1460D-01,0.1337D-01,0.1219D-01,0.1107D-01,0.9999D-02, | |
41784 | &0.8975D-02,0.8003D-02,0.7079D-02,0.6199D-02,0.5369D-02,0.4581D-02, | |
41785 | &0.3839D-02,0.3144D-02,0.2492D-02,0.1883D-02,0.1320D-02,0.8054D-03, | |
41786 | &0.7523D-03,0.7006D-03,0.6504D-03,0.6016D-03,0.5543D-03,0.5084D-03, | |
41787 | &0.4640D-03,0.4210D-03,0.3796D-03,0.3397D-03,0.3011D-03,0.2644D-03, | |
41788 | &0.2292D-03,0.1957D-03,0.1640D-03,0.1342D-03,0.1063D-03,0.8046D-04, | |
41789 | &0.5699D-04,0.3611D-04,0.1829D-04,0.4453D-05/ | |
41790 | DATA (XPV(I,7,1),I=1,100)/ | |
41791 | &0.1667D-01,0.1629D-01,0.1577D-01,0.1511D-01,0.1431D-01,0.1340D-01, | |
41792 | &0.1239D-01,0.1171D-01,0.1139D-01,0.1097D-01,0.1045D-01,0.9835D-02, | |
41793 | &0.9139D-02,0.8514D-02,0.8286D-02,0.7979D-02,0.7594D-02,0.7137D-02, | |
41794 | &0.6621D-02,0.6230D-02,0.6029D-02,0.5762D-02,0.5438D-02,0.5061D-02, | |
41795 | &0.4726D-02,0.4560D-02,0.4342D-02,0.4078D-02,0.3784D-02,0.3626D-02, | |
41796 | &0.3451D-02,0.3240D-02,0.3038D-02,0.2902D-02,0.2735D-02,0.2572D-02, | |
41797 | &0.2446D-02,0.2299D-02,0.2185D-02,0.2064D-02,0.1960D-02,0.1852D-02, | |
41798 | &0.1762D-02,0.1673D-02,0.1591D-02,0.1516D-02,0.1446D-02,0.1386D-02, | |
41799 | &0.1329D-02,0.1278D-02,0.1233D-02,0.1195D-02,0.1162D-02,0.1134D-02, | |
41800 | &0.1113D-02,0.1096D-02,0.1084D-02,0.1078D-02,0.1077D-02,0.1081D-02, | |
41801 | &0.1090D-02,0.1103D-02,0.1119D-02,0.1140D-02,0.1164D-02,0.1191D-02, | |
41802 | &0.1220D-02,0.1253D-02,0.1288D-02,0.1325D-02,0.1367D-02,0.1413D-02, | |
41803 | &0.1466D-02,0.1530D-02,0.1609D-02,0.1708D-02,0.1830D-02,0.1967D-02, | |
41804 | &0.1981D-02,0.1995D-02,0.2008D-02,0.2021D-02,0.2032D-02,0.2042D-02, | |
41805 | &0.2051D-02,0.2058D-02,0.2063D-02,0.2066D-02,0.2066D-02,0.2063D-02, | |
41806 | &0.2057D-02,0.2045D-02,0.2029D-02,0.2005D-02,0.1973D-02,0.1929D-02, | |
41807 | &0.1869D-02,0.1784D-02,0.1655D-02,0.1427D-02/ | |
41808 | DATA (XPV(I,7,2),I=1,100)/ | |
41809 | &0.1825D-01,0.1787D-01,0.1734D-01,0.1666D-01,0.1584D-01,0.1488D-01, | |
41810 | &0.1382D-01,0.1312D-01,0.1280D-01,0.1236D-01,0.1182D-01,0.1117D-01, | |
41811 | &0.1044D-01,0.9780D-02,0.9550D-02,0.9233D-02,0.8830D-02,0.8348D-02, | |
41812 | &0.7799D-02,0.7387D-02,0.7184D-02,0.6906D-02,0.6565D-02,0.6163D-02, | |
41813 | &0.5808D-02,0.5642D-02,0.5418D-02,0.5140D-02,0.4827D-02,0.4670D-02, | |
41814 | &0.4493D-02,0.4274D-02,0.4067D-02,0.3936D-02,0.3769D-02,0.3607D-02, | |
41815 | &0.3489D-02,0.3347D-02,0.3246D-02,0.3136D-02,0.3050D-02,0.2959D-02, | |
41816 | &0.2893D-02,0.2830D-02,0.2777D-02,0.2736D-02,0.2703D-02,0.2687D-02, | |
41817 | &0.2678D-02,0.2680D-02,0.2693D-02,0.2720D-02,0.2757D-02,0.2805D-02, | |
41818 | &0.2867D-02,0.2940D-02,0.3024D-02,0.3123D-02,0.3233D-02,0.3355D-02, | |
41819 | &0.3489D-02,0.3632D-02,0.3785D-02,0.3948D-02,0.4118D-02,0.4297D-02, | |
41820 | &0.4479D-02,0.4668D-02,0.4863D-02,0.5063D-02,0.5274D-02,0.5499D-02, | |
41821 | &0.5750D-02,0.6038D-02,0.6381D-02,0.6800D-02,0.7306D-02,0.7864D-02, | |
41822 | &0.7924D-02,0.7980D-02,0.8034D-02,0.8085D-02,0.8131D-02,0.8172D-02, | |
41823 | &0.8208D-02,0.8236D-02,0.8258D-02,0.8270D-02,0.8271D-02,0.8259D-02, | |
41824 | &0.8233D-02,0.8188D-02,0.8122D-02,0.8027D-02,0.7897D-02,0.7721D-02, | |
41825 | &0.7480D-02,0.7139D-02,0.6624D-02,0.5709D-02/ | |
41826 | DATA (XPV(I,7,3),I=1,100)/ | |
41827 | &0.1630D-01,0.1592D-01,0.1540D-01,0.1475D-01,0.1396D-01,0.1305D-01, | |
41828 | &0.1205D-01,0.1138D-01,0.1107D-01,0.1065D-01,0.1013D-01,0.9526D-02, | |
41829 | &0.8839D-02,0.8222D-02,0.7995D-02,0.7690D-02,0.7310D-02,0.6860D-02, | |
41830 | &0.6352D-02,0.5966D-02,0.5766D-02,0.5502D-02,0.5183D-02,0.4813D-02, | |
41831 | &0.4483D-02,0.4318D-02,0.4103D-02,0.3844D-02,0.3555D-02,0.3399D-02, | |
41832 | &0.3225D-02,0.3018D-02,0.2820D-02,0.2685D-02,0.2521D-02,0.2360D-02, | |
41833 | &0.2235D-02,0.2091D-02,0.1978D-02,0.1857D-02,0.1754D-02,0.1647D-02, | |
41834 | &0.1557D-02,0.1468D-02,0.1385D-02,0.1310D-02,0.1239D-02,0.1177D-02, | |
41835 | &0.1118D-02,0.1066D-02,0.1018D-02,0.9774D-03,0.9411D-03,0.9091D-03, | |
41836 | &0.8835D-03,0.8619D-03,0.8450D-03,0.8338D-03,0.8268D-03,0.8242D-03, | |
41837 | &0.8257D-03,0.8312D-03,0.8403D-03,0.8529D-03,0.8686D-03,0.8875D-03, | |
41838 | &0.9087D-03,0.9331D-03,0.9605D-03,0.9915D-03,0.1028D-02,0.1070D-02, | |
41839 | &0.1124D-02,0.1191D-02,0.1279D-02,0.1395D-02,0.1545D-02,0.1725D-02, | |
41840 | &0.1746D-02,0.1766D-02,0.1786D-02,0.1805D-02,0.1823D-02,0.1841D-02, | |
41841 | &0.1857D-02,0.1872D-02,0.1886D-02,0.1897D-02,0.1907D-02,0.1913D-02, | |
41842 | &0.1916D-02,0.1915D-02,0.1909D-02,0.1897D-02,0.1877D-02,0.1846D-02, | |
41843 | &0.1799D-02,0.1729D-02,0.1618D-02,0.1411D-02/ | |
41844 | DATA (XPV(I,7,4),I=1,100)/ | |
41845 | &0.1678D-01,0.1640D-01,0.1587D-01,0.1522D-01,0.1442D-01,0.1350D-01, | |
41846 | &0.1249D-01,0.1181D-01,0.1149D-01,0.1107D-01,0.1055D-01,0.9935D-02, | |
41847 | &0.9238D-02,0.8611D-02,0.8385D-02,0.8078D-02,0.7694D-02,0.7237D-02, | |
41848 | &0.6721D-02,0.6331D-02,0.6132D-02,0.5867D-02,0.5545D-02,0.5170D-02, | |
41849 | &0.4837D-02,0.4676D-02,0.4462D-02,0.4202D-02,0.3912D-02,0.3761D-02, | |
41850 | &0.3592D-02,0.3388D-02,0.3194D-02,0.3068D-02,0.2911D-02,0.2759D-02, | |
41851 | &0.2646D-02,0.2513D-02,0.2415D-02,0.2310D-02,0.2226D-02,0.2139D-02, | |
41852 | &0.2072D-02,0.2010D-02,0.1955D-02,0.1911D-02,0.1875D-02,0.1852D-02, | |
41853 | &0.1836D-02,0.1830D-02,0.1833D-02,0.1848D-02,0.1872D-02,0.1905D-02, | |
41854 | &0.1950D-02,0.2004D-02,0.2069D-02,0.2145D-02,0.2231D-02,0.2327D-02, | |
41855 | &0.2432D-02,0.2547D-02,0.2669D-02,0.2800D-02,0.2937D-02,0.3082D-02, | |
41856 | &0.3232D-02,0.3389D-02,0.3553D-02,0.3727D-02,0.3917D-02,0.4130D-02, | |
41857 | &0.4378D-02,0.4681D-02,0.5061D-02,0.5547D-02,0.6163D-02,0.6897D-02, | |
41858 | &0.6981D-02,0.7063D-02,0.7144D-02,0.7221D-02,0.7296D-02,0.7367D-02, | |
41859 | &0.7433D-02,0.7494D-02,0.7548D-02,0.7595D-02,0.7632D-02,0.7658D-02, | |
41860 | &0.7671D-02,0.7667D-02,0.7644D-02,0.7595D-02,0.7513D-02,0.7388D-02, | |
41861 | &0.7203D-02,0.6923D-02,0.6476D-02,0.5646D-02/ | |
41862 | ||
41863 | C..fetching pdfs | |
41864 | DO 5 IP=-6,6 | |
41865 | XPDF(IP)=ZEROD | |
41866 | 5 CONTINUE | |
41867 | DO 2 I=1,IX | |
41868 | ENT(I)=LOG10(XT(I)) | |
41869 | 2 CONTINUE | |
41870 | NA(1)=IX | |
41871 | NA(2)=IQ | |
41872 | DO 3 I=1,IQ | |
41873 | ENT(IX+I)=LOG10(Q2T(I)) | |
41874 | 3 CONTINUE | |
41875 | ARG(1)=LOG10(X) | |
41876 | ARG(2)=LOG10(Q2) | |
41877 | C..various flavours (u-->2,d-->1) | |
41878 | XPDF(0)=PHO_DBFINT(NARG,ARG,NA,ENT,XPV(1,1,0)) | |
41879 | XPDF(1)=PHO_DBFINT(NARG,ARG,NA,ENT,XPV(1,1,1)) | |
41880 | XPDF(2)=PHO_DBFINT(NARG,ARG,NA,ENT,XPV(1,1,2)) | |
41881 | XPDF(3)=PHO_DBFINT(NARG,ARG,NA,ENT,XPV(1,1,3)) | |
41882 | XPDF(4)=PHO_DBFINT(NARG,ARG,NA,ENT,XPV(1,1,4)) | |
41883 | DO 21 JF=1,4 | |
41884 | XPDF(-JF)=XPDF(JF) | |
41885 | 21 CONTINUE | |
41886 | ||
41887 | END | |
41888 | ||
41889 | *$ CREATE PHO_DBFINT.FOR | |
41890 | *COPY PHO_DBFINT | |
41891 | CDECK ID>, PHO_DBFINT | |
41892 | DOUBLE PRECISION FUNCTION PHO_DBFINT(NARG,ARG,NA,ENT,TABLE) | |
41893 | C*********************************************************************** | |
41894 | C | |
41895 | C routine based on CERN library E104 | |
41896 | C | |
41897 | C multi-dimensional interpolation routine, needed for PHOJET | |
41898 | C internal cross section tables and several PDF sets (GRV98 and AGL) | |
41899 | C | |
41900 | C changed to avoid recursive function calls (R.Engel, 09/98) | |
41901 | C | |
41902 | C*********************************************************************** | |
41903 | IMPLICIT DOUBLE PRECISION (A-H,O-Z) | |
41904 | SAVE | |
41905 | ||
41906 | INTEGER NA(NARG), INDEX(32) | |
41907 | DOUBLE PRECISION ARG(NARG),ENT(NARG),TABLE(*),WEIGHT(32) | |
41908 | ||
41909 | DATA ZEROD/0.D0/ | |
41910 | DATA ONED/1.D0/ | |
41911 | ||
41912 | DBFINT = ZEROD | |
41913 | PHO_DBFINT = ZEROD | |
41914 | IF(NARG .LT. 1 .OR. NARG .GT. 5) RETURN | |
41915 | ||
41916 | LMAX = 0 | |
41917 | ISTEP = 1 | |
41918 | KNOTS = 1 | |
41919 | INDEX(1) = 1 | |
41920 | WEIGHT(1) = ONED | |
41921 | DO 100 N = 1, NARG | |
41922 | X = ARG(N) | |
41923 | NDIM = NA(N) | |
41924 | LOCA = LMAX | |
41925 | LMIN = LMAX + 1 | |
41926 | LMAX = LMAX + NDIM | |
41927 | IF(NDIM .GT. 2) GOTO 10 | |
41928 | IF(NDIM .EQ. 1) GOTO 100 | |
41929 | H = X - ENT(LMIN) | |
41930 | IF(H .EQ. ZEROD) GOTO 90 | |
41931 | ISHIFT = ISTEP | |
41932 | IF(X-ENT(LMIN+1) .EQ. ZEROD) GOTO 21 | |
41933 | ISHIFT = 0 | |
41934 | ETA = H / (ENT(LMIN+1) - ENT(LMIN)) | |
41935 | GOTO 30 | |
41936 | 10 LOCB = LMAX + 1 | |
41937 | 11 LOCC = (LOCA+LOCB) / 2 | |
41938 | IF(X-ENT(LOCC)) 12, 20, 13 | |
41939 | 12 LOCB = LOCC | |
41940 | GOTO 14 | |
41941 | 13 LOCA = LOCC | |
41942 | 14 IF(LOCB-LOCA .GT. 1) GOTO 11 | |
41943 | LOCA = MIN ( MAX (LOCA,LMIN), LMAX-1 ) | |
41944 | ISHIFT = (LOCA - LMIN) * ISTEP | |
41945 | ETA = (X - ENT(LOCA)) / (ENT(LOCA+1) - ENT(LOCA)) | |
41946 | GOTO 30 | |
41947 | 20 ISHIFT = (LOCC - LMIN) * ISTEP | |
41948 | 21 DO 22 K = 1, KNOTS | |
41949 | INDEX(K) = INDEX(K) + ISHIFT | |
41950 | 22 CONTINUE | |
41951 | GOTO 90 | |
41952 | 30 DO 31 K = 1, KNOTS | |
41953 | INDEX(K) = INDEX(K) + ISHIFT | |
41954 | INDEX(K+KNOTS) = INDEX(K) + ISTEP | |
41955 | WEIGHT(K+KNOTS) = WEIGHT(K) * ETA | |
41956 | WEIGHT(K) = WEIGHT(K) - WEIGHT(K+KNOTS) | |
41957 | 31 CONTINUE | |
41958 | KNOTS = 2*KNOTS | |
41959 | 90 ISTEP = ISTEP * NDIM | |
41960 | 100 CONTINUE | |
41961 | DO 200 K = 1, KNOTS | |
41962 | I = INDEX(K) | |
41963 | DBFINT = DBFINT + WEIGHT(K) * TABLE(I) | |
41964 | 200 CONTINUE | |
41965 | ||
41966 | PHO_DBFINT = DBFINT | |
41967 | ||
41968 | END | |
41969 | ||
41970 | *$ CREATE PHVAL.FOR | |
41971 | *COPY PHVAL | |
41972 | CDECK ID>, PHVAL | |
41973 | SUBROUTINE PHVAL(IGRP,ISET,XI,SCALE2,PD,IRET) | |
41974 | C********************************************************************** | |
41975 | C | |
41976 | C dummy subroutine, remove to link PHOLIB | |
41977 | C | |
41978 | C********************************************************************** | |
41979 | IMPLICIT DOUBLE PRECISION (A-H,O-Z) | |
41980 | DIMENSION PD(-6:6) | |
41981 | END |