C++InterfacetoTauola
binp.f
1  SUBROUTINE curr_binp(MNUM,IMOD,P1,P2,P3,P4,HADCUR)
2 C Subroutine counting hadronic current (rho~ -> 4pi)
3 C Described in CPC. 146 (2002) 139-153 (hep-ph/0201149)
4 C
5 C MNUM = 1 tau+ -> pi,A1(rho+sigma) -> pi+pi-pi+pi0
6 C MNUM = 2 tau+ -> pi,A1(rho+sigma) -> pi+pi0pi0pi0
7 C
8 
9  real p1(4),p2(4),p3(4),p4(4),pa(4)
10  real*8 scalar ,ss2
11  real ssqrt,ss
12 
13  Complex*16 z_summ(4),z_vec(4),factor
14  Complex HADCUR(4)
15 
16  Logical atStart
17  real*8 invMrho4
18  real*8 AMass_Rho,Gamma_Rho
19  common /zrho_pool/ amass_rho,gamma_rho
20  data gamma_rho /0.1445d0/ ! 9 Jan 2002 Chnged Gamma_Rho /0.1477D0/
21  data amass_rho /0.7761d0/ ! 9 Jan 2002 Chnged AMass_Rho /0.7753D0/
22  data atstart/.true./
23 
24  if (atstart) then
25  atstart = .false.
26  invmrho4 = 1.d0/amass_rho**4
27  endif
28 
29  call lata(1,p1,p2,p3,p4)
30 
31  z_summ(1) = dcmplx(0.d0,0.d0)
32  z_summ(2) = dcmplx(0.d0,0.d0)
33  z_summ(3) = dcmplx(0.d0,0.d0)
34  z_summ(4) = dcmplx(0.d0,0.d0)
35 
36  do i=1,4
37  pa(i)=p1(i)+p2(i)+p3(i)+p4(i)
38  enddo
39  ss2=scalar(pa,pa)
40 
41  if(mnum.eq.2) then
42 
43  imod=-1
44 C Calculation Matrix element for tau -> pi,A1 -> pi+pi0pi0pi0
45 C via rho,pi
46  call t1(p2,p3,p1,p4,z_vec)
47  z_summ(1) = z_summ(1) + z_vec(1)
48  z_summ(2) = z_summ(2) + z_vec(2)
49  z_summ(3) = z_summ(3) + z_vec(3)
50  z_summ(4) = z_summ(4) + z_vec(4)
51 
52  call t1(p2,p4,p1,p3,z_vec)
53  z_summ(1) = z_summ(1) + z_vec(1)
54  z_summ(2) = z_summ(2) + z_vec(2)
55  z_summ(3) = z_summ(3) + z_vec(3)
56  z_summ(4) = z_summ(4) + z_vec(4)
57 
58  call t1(p3,p2,p1,p4,z_vec)
59  z_summ(1) = z_summ(1) + z_vec(1)
60  z_summ(2) = z_summ(2) + z_vec(2)
61  z_summ(3) = z_summ(3) + z_vec(3)
62  z_summ(4) = z_summ(4) + z_vec(4)
63 
64  call t1(p3,p4,p1,p2,z_vec)
65  z_summ(1) = z_summ(1) + z_vec(1)
66  z_summ(2) = z_summ(2) + z_vec(2)
67  z_summ(3) = z_summ(3) + z_vec(3)
68  z_summ(4) = z_summ(4) + z_vec(4)
69 
70  call t1(p4,p2,p1,p3,z_vec)
71  z_summ(1) = z_summ(1) + z_vec(1)
72  z_summ(2) = z_summ(2) + z_vec(2)
73  z_summ(3) = z_summ(3) + z_vec(3)
74  z_summ(4) = z_summ(4) + z_vec(4)
75 
76  call t1(p4,p3,p1,p2,z_vec)
77  z_summ(1) = z_summ(1) + z_vec(1)
78  z_summ(2) = z_summ(2) + z_vec(2)
79  z_summ(3) = z_summ(3) + z_vec(3)
80  z_summ(4) = z_summ(4) + z_vec(4)
81 
82 C Calculation Matrix element for tau -> pi,A1 -> pi+pi0pi0pi0
83 C via sigma,pi
84 
85 C !!!! Relative amplitude inserted into 't2' !!!!!
86 
87  call t2(p2,p1,p3,p4,z_vec)
88  z_summ(1) = z_summ(1) + z_vec(1)
89  z_summ(2) = z_summ(2) + z_vec(2)
90  z_summ(3) = z_summ(3) + z_vec(3)
91  z_summ(4) = z_summ(4) + z_vec(4)
92 
93  call t2(p3,p1,p2,p4,z_vec)
94  z_summ(1) = z_summ(1) + z_vec(1)
95  z_summ(2) = z_summ(2) + z_vec(2)
96  z_summ(3) = z_summ(3) + z_vec(3)
97  z_summ(4) = z_summ(4) + z_vec(4)
98 
99  call t2(p4,p1,p3,p2,z_vec)
100  z_summ(1) = z_summ(1) + z_vec(1)
101  z_summ(2) = z_summ(2) + z_vec(2)
102  z_summ(3) = z_summ(3) + z_vec(3)
103  z_summ(4) = z_summ(4) + z_vec(4)
104 
105  call t2(p1,p2,p3,p4,z_vec)
106  z_summ(1) = z_summ(1) - z_vec(1)
107  z_summ(2) = z_summ(2) - z_vec(2)
108  z_summ(3) = z_summ(3) - z_vec(3)
109  z_summ(4) = z_summ(4) - z_vec(4)
110 
111  call t2(p1,p3,p2,p4,z_vec)
112  z_summ(1) = z_summ(1) - z_vec(1)
113  z_summ(2) = z_summ(2) - z_vec(2)
114  z_summ(3) = z_summ(3) - z_vec(3)
115  z_summ(4) = z_summ(4) - z_vec(4)
116 
117  call t2(p1,p4,p3,p2,z_vec)
118  z_summ(1) = z_summ(1) - z_vec(1)
119  z_summ(2) = z_summ(2) - z_vec(2)
120  z_summ(3) = z_summ(3) - z_vec(3)
121  z_summ(4) = z_summ(4) - z_vec(4)
122 
123  elseif(mnum.eq.1) then
124 C Calculation Matrix element for tau -> pi,A1 -> pi+pi-pi+pi0
125 C via rho,pi
126  IF (imod.EQ.1) THEN
127  call t1(p1,p2,p3,p4,z_vec)
128  z_summ(1) = z_summ(1) + z_vec(1)
129  z_summ(2) = z_summ(2) + z_vec(2)
130  z_summ(3) = z_summ(3) + z_vec(3)
131  z_summ(4) = z_summ(4) + z_vec(4)
132 
133  call t1(p3,p2,p1,p4,z_vec)
134  z_summ(1) = z_summ(1) + z_vec(1)
135  z_summ(2) = z_summ(2) + z_vec(2)
136  z_summ(3) = z_summ(3) + z_vec(3)
137  z_summ(4) = z_summ(4) + z_vec(4)
138 
139  call t1(p1,p3,p2,p4,z_vec)
140  z_summ(1) = z_summ(1) + z_vec(1)
141  z_summ(2) = z_summ(2) + z_vec(2)
142  z_summ(3) = z_summ(3) + z_vec(3)
143  z_summ(4) = z_summ(4) + z_vec(4)
144 
145  call t1(p3,p1,p2,p4,z_vec)
146  z_summ(1) = z_summ(1) + z_vec(1)
147  z_summ(2) = z_summ(2) + z_vec(2)
148  z_summ(3) = z_summ(3) + z_vec(3)
149  z_summ(4) = z_summ(4) + z_vec(4)
150 
151  call t1(p4,p3,p1,p2,z_vec)
152  z_summ(1) = z_summ(1) + z_vec(1)
153  z_summ(2) = z_summ(2) + z_vec(2)
154  z_summ(3) = z_summ(3) + z_vec(3)
155  z_summ(4) = z_summ(4) + z_vec(4)
156 
157  call t1(p4,p1,p3,p2,z_vec)
158  z_summ(1) = z_summ(1) + z_vec(1)
159  z_summ(2) = z_summ(2) + z_vec(2)
160  z_summ(3) = z_summ(3) + z_vec(3)
161  z_summ(4) = z_summ(4) + z_vec(4)
162 
163 C Calculation Matrix element for tau -> pi,A1 -> pi+pi-pi+pi0
164 C via sigma,pi
165 
166 C !!!! Relative amplitude inserted into 't2' !!!!!
167 
168  call t2(p4,p3,p1,p2,z_vec)
169  z_summ(1) = z_summ(1) + z_vec(1)
170  z_summ(2) = z_summ(2) + z_vec(2)
171  z_summ(3) = z_summ(3) + z_vec(3)
172  z_summ(4) = z_summ(4) + z_vec(4)
173 
174  call t2(p4,p1,p3,p2,z_vec)
175  z_summ(1) = z_summ(1) + z_vec(1)
176  z_summ(2) = z_summ(2) + z_vec(2)
177  z_summ(3) = z_summ(3) + z_vec(3)
178  z_summ(4) = z_summ(4) + z_vec(4)
179 
180  call t2(p3,p4,p1,p2,z_vec)
181  z_summ(1) = z_summ(1) - z_vec(1)
182  z_summ(2) = z_summ(2) - z_vec(2)
183  z_summ(3) = z_summ(3) - z_vec(3)
184  z_summ(4) = z_summ(4) - z_vec(4)
185 
186  call t2(p1,p4,p3,p2,z_vec)
187  z_summ(1) = z_summ(1) - z_vec(1)
188  z_summ(2) = z_summ(2) - z_vec(2)
189  z_summ(3) = z_summ(3) - z_vec(3)
190  z_summ(4) = z_summ(4) - z_vec(4)
191 
192 C Calculation Matrix element for tau -> pi,omega -> pi+pi-pi+pi0
193 C via rho,pi
194  ELSEIF (imod.EQ.7) THEN
195 
196  call t3(p1,p2,p3,p4,z_vec)
197  z_summ(1) = z_summ(1) + z_vec(1)
198  z_summ(2) = z_summ(2) + z_vec(2)
199  z_summ(3) = z_summ(3) + z_vec(3)
200  z_summ(4) = z_summ(4) + z_vec(4)
201 
202  call t3(p3,p2,p1,p4,z_vec)
203  z_summ(1) = z_summ(1) + z_vec(1)
204  z_summ(2) = z_summ(2) + z_vec(2)
205  z_summ(3) = z_summ(3) + z_vec(3)
206  z_summ(4) = z_summ(4) + z_vec(4)
207 
208  call t3(p1,p3,p2,p4,z_vec)
209  z_summ(1) = z_summ(1) - z_vec(1)
210  z_summ(2) = z_summ(2) - z_vec(2)
211  z_summ(3) = z_summ(3) - z_vec(3)
212  z_summ(4) = z_summ(4) - z_vec(4)
213 
214  call t3(p3,p1,p2,p4,z_vec)
215  z_summ(1) = z_summ(1) - z_vec(1)
216  z_summ(2) = z_summ(2) - z_vec(2)
217  z_summ(3) = z_summ(3) - z_vec(3)
218  z_summ(4) = z_summ(4) - z_vec(4)
219 
220  call t3(p1,p4,p3,p2,z_vec)
221  z_summ(1) = z_summ(1) - z_vec(1)
222  z_summ(2) = z_summ(2) - z_vec(2)
223  z_summ(3) = z_summ(3) - z_vec(3)
224  z_summ(4) = z_summ(4) - z_vec(4)
225 
226  call t3(p3,p4,p1,p2,z_vec)
227  z_summ(1) = z_summ(1) - z_vec(1)
228  z_summ(2) = z_summ(2) - z_vec(2)
229  z_summ(3) = z_summ(3) - z_vec(3)
230  z_summ(4) = z_summ(4) - z_vec(4)
231 
232  ENDIF
233 
234  else
235  go to 910
236  endif
237  ssqrt=sqrt(ss2)
238  ss=ss2
239 C
240  if (mnum.eq.1) then
241 C
242  if(imod.eq.1) then
243 C factor == "function G_pi+_pi-_pi+_pi0(Q^2)" see Eq.(22,23)hep-ph/0201149
244 C and Eq.(1) in internal note.
245  factor= fit_a1_1(ssqrt) * 76.565033643843d0*
246  $ sqrt(0.71709*ssqrt-0.27505)*invmrho4/ssqrt
247  elseif(imod.eq.7) then
248 C factor == "function G^{omega}_pi+_pi-_pi+_pi0(Q^2)" see Eq.(24)
249 C hep-ph/0201149 and Eq.(2) in internal note.
250  factor= fit_om_1(ssqrt) * 886.837943974463d0 *
251  $ sqrt(0.70983*ssqrt-0.26689)*invmrho4/ssqrt
252  else
253  write(*,*)' Wrong IMOD=',imod,' !'
254  stop
255  endif
256 C
257  elseif(mnum.eq.2) then
258 C factor == "function G_pi+_pi0_pi0_pi0(Q^2)" see Eq.(14,15)hep-ph/0201149
259 C and Eq.(3) in internal note.
260  factor= fit_2(ssqrt) * 96.867161854922d0* zfa1tab(ss)*
261  $ sqrt(0.70907*ssqrt-0.26413)*invmrho4/ssqrt
262 C
263  else
264 C
265  write(*,*)' WRONG MNUM ! MNUM=',mnum
266  stop
267 C
268  endif
269  do i=1,4
270  z_summ(i) = z_summ(i)*factor
271  enddo
272  DO i=1,4
273  hadcur(i)=z_summ(i)
274  ENDDO
275  call lata(-1,p1,p2,p3,p4)
276  RETURN
277  910 print 9100
278  9100 FORMAT(' ----- WRONG VALUE OF MNUM ')
279  stop
280  END
281 
282  subroutine t1(p1,p2,p3,p4,z_vec)
283 C Function t1 - Eq.(16) hep-ph/0201149 (see also internal note
284 C point 5)
285 C
286 C Based on "z_a1rho" subroutine - Novosibirsk code
287 C Calculation of matrix element for ee -> pi,a1
288 C ee == p1,A1
289 C A1 == p2,Rho
290 C Rho == p3,p4
291 
292  IMPLICIT none
293  INTEGER i,jnpi
294 
295  real p1(4),p2(4),p3(4),p4(4),pa(4)
296 
297  complex*16 z_vec(4),z_ee
298  Complex*16 Z_a1,Z_rho
299  Complex*16 Z_da1,Z_drho,fcom
300 
301  real*8 AMass_Rho,Gamma_Rho
302  common /zrho_pool/ amass_rho,gamma_rho
303  real*8 AMass_A,Gamma_A,Scale_A
304  Complex*16 DSigma_A
305  common /za1p_pool/ amass_a,gamma_a,scale_a,dsigma_a
306 
307  real*8 sa,fs,scalar
308  real*8 PPp1,p4Pp1,p3Pp1,p3P,p4P,p1p3,p1p4
309 
310 
311  z_rho = z_drho(p3,p4)
312  pa(1)=p1(1)+p2(1)+p3(1)+p4(1) ! E
313  pa(2)=p1(2)+p2(2)+p3(2)+p4(2) !px
314  pa(3)=p1(3)+p2(3)+p3(3)+p4(3) !py
315  pa(4)=p1(4)+p2(4)+p3(4)+p4(4) !pz
316 
317  sa = (pa(1)-p1(1))**2 - (pa(2)-p1(2))**2 -
318  $ (pa(3)-p1(3))**2 - (pa(4)-p1(4))**2
319 
320  z_a1 = z_da1(sa)
321 
322  fs = ((1.d0+amass_a**2/scale_a)/(1.d0+sa/scale_a))**2
323 
324  fcom = fs/(z_a1*z_rho)
325 
326  ppp1 = scalar(pa,pa) - scalar(pa,p1)
327  p4pp1 = scalar(p4,pa) - scalar(p4,p1)
328  p3pp1 = scalar(p3,pa) - scalar(p3,p1)
329  p3p = scalar(p3,pa)
330  p4p = scalar(p4,pa)
331  p1p3 = scalar(p1,p3)
332  p1p4 = scalar(p1,p4)
333 
334  do i=1,4
335  z_vec(i) = fcom*(ppp1*(p3(i)*p4pp1 - p4(i)*p3pp1) +
336  $ (pa(i) - p1(i))*(p3p*p1p4-p4p*p1p3))
337  enddo
338 C Changing 4 vector convention to (x,y,z,e) like in TAUOLA
339  z_ee=z_vec(1)
340  do i=1,3
341  z_vec(i) = z_vec(i+1)
342  enddo
343  z_vec(4)= z_ee
344  end
345 
346  subroutine t2(p1,p2,p3,p4,z_vec)
347 C Function t2 - Eq.(17) hep-ph/0201149
348 C
349 C Based on "z_a1sigma" subroutine - Novosibirsk code
350 C Calculation of matrix element for ee -> pi,a1 -> pi,pi,Sigma
351 C ee == p1,A1
352 C A1 == p2,Sigma
353 C Sigma == p3,p4
354 
355  IMPLICIT none
356  INTEGER i
357 
358  real p1(4),p2(4),p3(4),p4(4),pa(4)
359 
360  complex*16 z_vec(4),z_ee
361  Complex*16 Z_a1,Z_sgm,fcom
362  Complex*16 Z_da1,Z_dsigma
363 
364  real*8 AMass_Rho,Gamma_Rho
365  common /zrho_pool/ amass_rho,gamma_rho
366 
367  real*8 AMass_A,Gamma_A,Scale_A
368  Complex*16 DSigma_A
369  common /za1p_pool/ amass_a,gamma_a,scale_a,dsigma_a
370 
371  real*8 sa,fs,scalar
372  real*8 PPp1,p2P
373 
374  z_sgm = z_dsigma(p3,p4)
375 
376  pa(1)=p1(1)+p2(1)+p3(1)+p4(1) ! E
377  pa(2)=p1(2)+p2(2)+p3(2)+p4(2) !px
378  pa(3)=p1(3)+p2(3)+p3(3)+p4(3) !py
379  pa(4)=p1(4)+p2(4)+p3(4)+p4(4) !pz
380 
381  sa = (pa(1)-p1(1))**2 - (pa(2)-p1(2))**2 -
382  $ (pa(3)-p1(3))**2 - (pa(4)-p1(4))**2
383  z_a1 = z_da1(sa)
384 
385 C Q^2 for A1
386 
387  fs = ((1.d0+amass_a**2/scale_a)/(1.d0+sa/scale_a))**2
388 
389  fcom = fs*dsigma_a/(z_a1*z_sgm)*sa
390 
391  ppp1 = scalar(pa,pa) - scalar(pa,p1)
392  p2p = scalar(p2,pa)
393  do i = 1,4
394  z_vec(i) = fcom*(p2(i)*ppp1 + (p1(i)-pa(i))*p2p)
395  enddo
396 C Changing 4 vector convention to (x,y,z,e) like in TAUOLA
397  z_ee=z_vec(1)
398  do i=1,3
399  z_vec(i) = z_vec(i+1)
400  enddo
401  z_vec(4)= z_ee
402  end
403 
404  real*8 function scalar(a,b)
405 c real scalar product
406  real a(4),b(4)
407  scalar = a(1)*b(1)-a(2)*b(2)-a(3)*b(3)-a(4)*b(4)
408  end
409 
410 C---------------------------------------------------------------
411 C Breit-Wigner for a1, rho, sigma
412 C----------------------------------------------------------------
413  complex*16 function z_da1(sa_q)
414 C Calculation of A1 propagator (see Eq.(18) from hep-ph/0201149
415 C and point 2 from internal note)
416 C
417 C p_q - pion with A1
418 C p1,p2 - pions from Rho
419 C p3 - pion from A1
420 C
421  implicit none
422 
423  real*8 AMass_A,Gamma_A,Scale_A
424  Complex*16 DWave_A
425  common /za1p_pool/ amass_a,gamma_a,scale_a,dwave_a
426 
427  integer ia1f
428  real*8 ama1,gma1,gmv0
429 
430  real*8 sa_q,pm,pm0
431  real*8 gma1v
432 
433  data ia1f/0/
434  data gamma_a /0.45d0/
435  data amass_a /1.23d0/
436  data scale_a /1.2d0/
437  data dwave_a / (1.269d0,0.591d0) /
438 
439 C New way of correction
440 C
441  if(ia1f.eq.0) then
442  ia1f = 1
443 
444  ama1 = amass_a**2
445  gma1 = gamma_a/amass_a
446  gmv0 = gma1v(ama1)
447  endif
448  pm0 = gmv0 ! normalization width
449  pm = gma1v(sa_q) ! resonanse width
450 
451 C Normalization
452 C
453  z_da1 = dcmplx(sa_q/ama1-1.d0,gma1*pm/pm0)
454  end
455 
456  double precision function gma1v(X2)
457 C a1 width, a1 -> pi+ pi- pi0 or 3pi0
458 C Eq. (18) hep-ph/0201149 and points 6-9 from internal note
459  implicit none
460 
461  real*8 AMass_A,Gamma_A,Scale_A
462  Complex*16 Z
463  common /za1p_pool/ amass_a,gamma_a,scale_a,z
464 
465  real*8 fs
466  REAL*8 X2,DELTA,GA1MY
467  INTEGER I
468  REAL*8 S(100),INTE(100),INT_ABS(100),INT_RE(100),INT_IM(100)
469  DATA s/0.17531806e+00,0.20062977e+00,0.22594148e+00,0.25125318e+00,
470  #0.27656489e+00,0.30187660e+00,0.32718830e+00,0.35250001e+00,0.37781172e+00,0.40312342e+00,
471  #0.42843513e+00,0.45374684e+00,0.47905854e+00,0.50437025e+00,0.52968195e+00,0.55499366e+00,
472  #0.58030537e+00,0.60561707e+00,0.63092878e+00,0.65624049e+00,0.68155219e+00,0.70686390e+00,
473  #0.73217561e+00,0.75748731e+00,0.78279902e+00,0.80811073e+00,0.83342243e+00,0.85873414e+00,
474  #0.88404585e+00,0.90935755e+00,0.93466926e+00,0.95998096e+00,0.98529267e+00,0.10106044e+01,
475  #0.10359161e+01,0.10612278e+01,0.10865395e+01,0.11118512e+01,0.11371629e+01,0.11624746e+01,
476  #0.11877863e+01,0.12130980e+01,0.12384097e+01,0.12637214e+01,0.12890331e+01,0.13143449e+01,
477  #0.13396566e+01,0.13649683e+01,0.13902800e+01,0.14155917e+01,0.14409034e+01,0.14662151e+01,
478  #0.14915268e+01,0.15168385e+01,0.15421502e+01,0.15674619e+01,0.15927736e+01,0.16180853e+01,
479  #0.16433970e+01,0.16687087e+01,0.16940205e+01,0.17193322e+01,0.17446439e+01,0.17699556e+01,
480  #0.17952673e+01,0.18205790e+01,0.18458907e+01,0.18712024e+01,0.18965141e+01,0.19218258e+01,
481  #0.19471375e+01,0.19724492e+01,0.19977609e+01,0.20230726e+01,0.20483843e+01,0.20736960e+01,
482  #0.20990078e+01,0.21243195e+01,0.21496312e+01,0.21749429e+01,0.22002546e+01,0.22255663e+01,
483  #0.22508780e+01,0.22761897e+01,0.23015014e+01,0.23268131e+01,0.23521248e+01,0.23774365e+01,
484  #0.24027482e+01,0.24280599e+01,0.24533716e+01,0.24786834e+01,0.25039951e+01,0.25293068e+01,
485  #0.25546185e+01,0.25799302e+01,0.26052419e+01,0.26305536e+01,0.26558653e+01,0.26811770e+01/
486  DATA inte/0.00000000e+00,0.19835316e-09,0.17277872e-08,0.63260250e-08,
487  #0.16228446e-07,0.34254199e-07,0.63924158e-07,0.10961715e-06,0.17677484e-06,0.27217027e-06,
488  #0.40426145e-06,0.58366008e-06,0.82375764e-06,0.11415688e-05,0.15588754e-05,0.21037881e-05,
489  #0.28128794e-05,0.37340827e-05,0.49305520e-05,0.64855462e-05,0.85079467e-05,0.11136565e-04,
490  #0.14538578e-04,0.18892731e-04,0.24346357e-04,0.30949160e-04,0.38601580e-04,0.47069702e-04,
491  #0.56065745e-04,0.65330521e-04,0.74672459e-04,0.83967396e-04,0.93142038e-04,0.10215726e-03,
492  #0.11099490e-03,0.11964932e-03,0.12812206e-03,0.13641877e-03,0.14454677e-03,0.15251471e-03,
493  #0.16033133e-03,0.16800535e-03,0.17554509e-03,0.18295843e-03,0.19025283e-03,0.19743618e-03,
494  #0.20451223e-03,0.21148974e-03,0.21837340e-03,0.22516843e-03,0.23187967e-03,0.23851165e-03,
495  #0.24506849e-03,0.25155433e-03,0.25797236e-03,0.26432627e-03,0.27061916e-03,0.27685378e-03,
496  #0.28303336e-03,0.28916027e-03,0.29523695e-03,0.30126590e-03,0.30724868e-03,0.31318791e-03,
497  #0.31908532e-03,0.32494289e-03,0.33076174e-03,0.33654407e-03,0.34229119e-03,0.34800456e-03,
498  #0.35368553e-03,0.35933539e-03,0.36495540e-03,0.37054666e-03,0.37611031e-03,0.38164760e-03,
499  #0.38715892e-03,0.39264583e-03,0.39810880e-03,0.40354939e-03,0.40896773e-03,0.41436490e-03,
500  #0.41974145e-03,0.42509830e-03,0.43043607e-03,0.43575541e-03,0.44105696e-03,0.44634150e-03,
501  #0.45160906e-03,0.45686072e-03,0.46209683e-03,0.46731790e-03,0.47252442e-03,0.47771686e-03,
502  #0.48289566e-03,0.48806125e-03,0.49321407e-03,0.49835450e-03,0.50348292e-03,0.50859971e-03/
503  DATA int_abs/0.00000000e+00,0.21066009e-09,0.16564992e-08,0.55359496e-08,
504  #0.13052891e-07,0.25435346e-07,0.43943074e-07,0.69871482e-07,0.10455410e-06,0.14936437e-06,
505  #0.20571712e-06,0.27506977e-06,0.35892330e-06,0.45882244e-06,0.57635873e-06,0.71316741e-06,
506  #0.87092972e-06,0.10513722e-05,0.12562662e-05,0.14874272e-05,0.17467133e-05,0.20360241e-05,
507  #0.23572986e-05,0.27125129e-05,0.31036774e-05,0.35328342e-05,0.40020531e-05,0.45134287e-05,
508  #0.50690759e-05,0.56711263e-05,0.63217233e-05,0.70230186e-05,0.77771640e-05,0.85863202e-05,
509  #0.94526337e-05,0.10378245e-04,0.11365281e-04,0.12415854e-04,0.13532054e-04,0.14715952e-04,
510  #0.15969588e-04,0.17294974e-04,0.18694106e-04,0.20168926e-04,0.21721372e-04,0.23353312e-04,
511  #0.25066665e-04,0.26863051e-04,0.28744432e-04,0.30712501e-04,0.32768956e-04,0.34915462e-04,
512  #0.37153651e-04,0.39485116e-04,0.41911400e-04,0.44434054e-04,0.47054555e-04,0.49774355e-04,
513  #0.52594877e-04,0.55517507e-04,0.58543603e-04,0.61674489e-04,0.64911460e-04,0.68255782e-04,
514  #0.71708689e-04,0.75271391e-04,0.78945069e-04,0.82730875e-04,0.86629940e-04,0.90643366e-04,
515  #0.94772202e-04,0.99017560e-04,0.10338045e-03,0.10786187e-03,0.11246282e-03,0.11718426e-03,
516  #0.12204385e-03,0.12699238e-03,0.13208090e-03,0.13729358e-03,0.14263128e-03,0.14809487e-03,
517  #0.15368518e-03,0.15940303e-03,0.16524921e-03,0.17122452e-03,0.17732972e-03,0.18356558e-03,
518  #0.18993282e-03,0.19643219e-03,0.20306438e-03,0.20983011e-03,0.21673005e-03,0.22376489e-03,
519  #0.23093528e-03,0.23824187e-03,0.24568530e-03,0.25326619e-03,0.26098517e-03,0.26884283e-03/
520  DATA int_re/0.00000000e+00,-.38711044e-09,-.30791558e-08,-.10445232e-07,
521  #-.25062489e-07,-.49803729e-07,-.87911341e-07,-.14307792e-06,-.21954305e-06,-.32221399e-06,
522  #-.45681885e-06,-.63010309e-06,-.85008368e-06,-.11263793e-05,-.14706404e-05,-.18971082e-05,
523  #-.24233327e-05,-.30710710e-05,-.38673463e-05,-.48455316e-05,-.60460375e-05,-.75155863e-05,
524  #-.93030466e-05,-.11448885e-04,-.13966772e-04,-.16823546e-04,-.19934441e-04,-.23185919e-04,
525  #-.26472191e-04,-.29719254e-04,-.32887419e-04,-.35962204e-04,-.38944230e-04,-.41841471e-04,
526  #-.44665024e-04,-.47426566e-04,-.50137251e-04,-.52807218e-04,-.55445447e-04,-.58059837e-04,
527  #-.60657047e-04,-.63242968e-04,-.65822615e-04,-.68400294e-04,-.70979704e-04,-.73564030e-04,
528  #-.76155632e-04,-.78758044e-04,-.81372163e-04,-.84000166e-04,-.86643611e-04,-.89303861e-04,
529  #-.91982105e-04,-.94679390e-04,-.97396632e-04,-.10013464e-03,-.10289412e-03,-.10567554e-03,
530  #-.10847991e-03,-.11130726e-03,-.11415800e-03,-.11703298e-03,-.11993205e-03,-.12285565e-03,
531  #-.12580402e-03,-.12877720e-03,-.13177591e-03,-.13479977e-03,-.13784908e-03,-.14092395e-03,
532  #-.14402448e-03,-.14715072e-03,-.15030274e-03,-.15348058e-03,-.15668426e-03,-.15991379e-03,
533  #-.16316917e-03,-.16645040e-03,-.16975745e-03,-.17309031e-03,-.17644893e-03,-.17983303e-03,
534  #-.18324331e-03,-.18667896e-03,-.19014018e-03,-.19362689e-03,-.19713905e-03,-.20067656e-03,
535  #-.20423936e-03,-.20782708e-03,-.21144049e-03,-.21507866e-03,-.21874178e-03,-.22242976e-03,
536  #-.22614252e-03,-.22987995e-03,-.23364196e-03,-.23742846e-03,-.24123935e-03,-.24507452e-03/
537  DATA int_im/0.00000000e+00,0.12002091e-09,0.12850209e-08,0.51141443e-08,
538  #0.13632230e-07,0.29227933e-07,0.54655557e-07,0.93051069e-07,0.14795445e-06,0.22333412e-06,
539  #0.32360920e-06,0.45366352e-06,0.61884173e-06,0.82491108e-06,0.10779615e-05,0.13841975e-05,
540  #0.17495437e-05,0.21789224e-05,0.26750078e-05,0.32360835e-05,0.38525487e-05,0.45015863e-05,
541  #0.51400771e-05,0.56980360e-05,0.60787180e-05,0.61747611e-05,0.59005563e-05,0.52216022e-05,
542  #0.41575455e-05,0.27611998e-05,0.10942719e-05,-.78733816e-06,-.28386020e-05,-.50252585e-05,
543  #-.73219124e-05,-.97098783e-05,-.12175421e-04,-.14708367e-04,-.17301124e-04,-.19947904e-04,
544  #-.22644299e-04,-.25386852e-04,-.28172810e-04,-.30999930e-04,-.33866347e-04,-.36770471e-04,
545  #-.39710918e-04,-.42686461e-04,-.45695990e-04,-.48738489e-04,-.51813066e-04,-.54918732e-04,
546  #-.58054706e-04,-.61220193e-04,-.64414436e-04,-.67636711e-04,-.70886320e-04,-.74162594e-04,
547  #-.77464884e-04,-.80792567e-04,-.84145039e-04,-.87521715e-04,-.90922031e-04,-.94345438e-04,
548  #-.97791406e-04,-.10125942e-03,-.10474898e-03,-.10825960e-03,-.11179082e-03,-.11534217e-03,
549  #-.11891322e-03,-.12250352e-03,-.12611268e-03,-.12974120e-03,-.13338592e-03,-.13704922e-03,
550  #-.14072981e-03,-.14442733e-03,-.14814143e-03,-.15187176e-03,-.15561799e-03,-.15937980e-03,
551  #-.16315687e-03,-.16694889e-03,-.17075556e-03,-.17457660e-03,-.17841171e-03,-.18226185e-03,
552  #-.18612432e-03,-.19000007e-03,-.19388755e-03,-.19778906e-03,-.20170309e-03,-.20562942e-03,
553  #-.20956779e-03,-.21351800e-03,-.21747982e-03,-.22145304e-03,-.22543745e-03,-.22943284e-03/
554 
555  delta = s(2)-s(1)
556  i = int((x2-s(1))/delta) + 1
557 
558  ga1my = inte(i) + (inte(i+1)-inte(i))/delta*(x2-s(i))
559  ga1my = ga1my + abs(z)**2 * (int_abs(i) + (int_abs(i+1)-int_abs(i))/delta*(x2-s(i)))
560  ga1my = ga1my + dble(z)* (int_re(i) + (int_re(i+1)-int_re(i))/delta*(x2-s(i)))
561  ga1my = ga1my + dimag(z)*(int_im(i) + (int_im(i+1)-int_im(i))/delta*(x2-s(i)))
562 
563  fs = ((1.d0+amass_a**2/scale_a)/(1.d0+x2/scale_a))**2
564  gma1v=fs*ga1my
565  end
566 
567  complex*16 function z_dsigma(p1,p2)
568 C Calculation of Sigma propagator (see Eq.(18) from hep-ph/0201149
569 C and point 2 from internal note)
570 C
571 C p1,p2 - pions from Sigma
572 C
573  implicit none
574 
575  real*8 AMass_S,Gamma_S
576 
577  real p1(4),p2(4)
578  real*8 ps1,ps2,am2_1,am2_2,as,d1,d2,dsq,pm,pm0,dd,am12
579  real*8 am1,am2
580 
581  data gamma_s /0.8d0/
582  data amass_s /0.8d0/
583 
584  ps1 = p1(2)**2+p1(3)**2+p1(4)**2
585  ps2 = p2(2)**2+p2(3)**2+p2(4)**2
586 
587  am2_1 = p1(1)**2-ps1
588  am2_2 = p2(1)**2-ps2
589 
590  am12 = p1(1)*p2(1)-p1(2)*p2(2)-p1(3)*p2(3)-p1(4)*p2(4)
591  as = am2_1+am2_2+2.d0*am12 ! Sigma invariant mass
592 
593  am1 = sqrt(am2_1)
594  am2 = sqrt(am2_2)
595  d1 = 1.d0-(am1+am2)**2/as
596  d2 = 1.d0-(am1-am2)**2/as
597  dd = max(d1*d2,1.d-16)
598 
599  dsq = sqrt(dd)
600  pm = dsq
601 
602  d1 = 1.d0-(am1+am2)**2/amass_s**2
603  d2 = 1.d0-(am1-am2)**2/amass_s**2
604  dd = d1*d2
605  dsq = sqrt(dd)
606  pm0 = dsq
607 
608  z_dsigma = dcmplx(as/amass_s**2-1.d0,gamma_s/amass_s*pm/pm0)
609  end
610 
611  complex*16 function z_drho(p1,p2)
612 C Calculation of rho propagator (see Eq.(18) from hep-ph/0201149
613 C and point 2,3(Eq.(4)) from internal note)
614 
615 C Denominator of Rho propagator.
616  implicit none
617  real p1(4),p2(4)
618 
619  real*8 AMass_Rho,Gamma_Rho,ampi,s,g,GamMas,dm
620  common /zrho_pool/ amass_rho,gamma_rho
621 
622  parameter(ampi=.13957d0)
623 
624  g(s) = sqrt(max((s-4.*ampi**2)**3/s,0.d0))
625 
626  s = (p1(1)+p2(1))**2 -(p1(2)+p2(2))**2-(p1(3)+p2(3))**2-
627  # (p1(4)+p2(4))**2
628 
629  gammas = gamma_rho*amass_rho
630  z_drho = COMPLEX(s-AMass_Rho**2-dm(s)*GamMas,GamMas*g(s)/g(AMass_Rho**2))
631  z_drho = z_drho / amass_rho**2
632  z_drho = z_drho /(1.+ gamma_rho/amass_rho*dm(0.d0)) ! Normalization
633  end
634 
635  real*8 function dm(s)
636 C Mass correction to the rho propagator (see Eq.(4,5) from internal note)
637  implicit none
638  real*8 s,m2,gm2,hrho,dhrho
639  real*8 ampi,pi
640  real*8 AMass_Rho,Gamma_Rho
641  common /zrho_pool/ amass_rho,gamma_rho
642  parameter(ampi=.13957d0)
643  parameter(pi=3.1415926d0)
644 
645  m2 = amass_rho**2
646  gm2=m2*(sqrt(1.d0-(2.d0*ampi)**2/m2))**3
647  dm = (hrho(s)-hrho(m2)-(s-m2)*dhrho(m2))/gm2
648  end
649  real*8 function hrho(s)
650 C See Eq.(5) from internal note
651  implicit none
652  real*8 s,pi,ampi,y,w
653  parameter(ampi=.13957d0)
654  parameter(pi=3.1415926d0)
655 
656  if (s.eq.0.d0) then
657  hrho = -2.d0*4.d0*ampi**2/pi
658  else
659  y=1.d0-4.d0*ampi**2/s
660  y = sqrt(max(0.d0,y))
661  w = y*log((1.d0+y)/(1.d0-y))
662  hrho = w*(s-4.d0*ampi**2)/pi
663  endif
664  end
665  real*8 function dhrho(s)
666 C Derivative of function hrho(s), for more information see Eq.(4,5)
667 C from internal note
668  implicit none
669  real*8 s,pi,ampi,y,a,w,dy
670  parameter(ampi=.13957d0)
671  parameter(pi=3.1415926d0)
672 
673  y=1.d0-4.d0*ampi**2/s
674  y = sqrt(max(0.d0,y))
675  a = log((1.d0+y)/(1.d0-y))
676  w = y*a
677  dy= 4.d0*ampi**2/2.d0/s/y
678  dhrho = (w + (dy*a+1.d0)*y**2)/pi
679  end
680 
681  subroutine lata(key,p1,p2,p3,p4)
682 C Subroutine changing 4 vector convention (x,y,z,e) <=> (e,x,y,z)
683  real ee1,ee2,ee3,ee4,p1(4),p2(4),p3(4),p4(4)
684  integer key
685  if (key.eq.1) then ! (x,y,z,e) -> (e,x,y,z)
686 C from TAUOLA to BINP
687  ee1=p1(4)
688  ee2=p2(4)
689  ee3=p3(4)
690  ee4=p4(4)
691  do i=3,1,-1
692  p1(i+1)=p1(i)
693  p2(i+1)=p2(i)
694  p3(i+1)=p3(i)
695  p4(i+1)=p4(i)
696  enddo
697  p1(1)=ee1
698  p2(1)=ee2
699  p3(1)=ee3
700  p4(1)=ee4
701  else ! (e,x,y,z) -> (x,y,z,e)
702  ee1=p1(1)
703  ee2=p2(1)
704  ee3=p3(1)
705  ee4=p4(1)
706  do i=1,3
707  p1(i)=p1(i+1)
708  p2(i)=p2(i+1)
709  p3(i)=p3(i+1)
710  p4(i)=p4(i+1)
711  enddo
712  p1(4)=ee1
713  p2(4)=ee2
714  p3(4)=ee3
715  p4(4)=ee4
716  endif
717  end
718  subroutine t3(p1,p2,p3,p4,z_vec)
719 C Function t3 - Eq.(25) hep-ph/0201149 (see also internal note point 10)
720 C
721 C Based on "z_omegav" subroutine - Novosibirsk code
722 C Calculation of matrix element for tau- -> pi-,omega
723 C Rho == p3,p4
724 C Omega == p2,Rho
725 
726  IMPLICIT none
727 
728  INTEGER i
729  real p1(4),p2(4),p3(4),p4(4),PA(4)
730 
731  real*8 scalar,Pp2,Pp3,Pp4,p1p2,p1p3,p1p4
732  complex*16 z_vec(4),z_ee
733  Complex*16 Z_a1,Z_rho
734  Complex*16 Z_domega,Z_drho,fcom,zmix
735 
736  real*8 AMass_Rho,Gamma_Rho
737  common /zrho_pool/ amass_rho,gamma_rho
738  real*8 som,fs
739 
740  zmix=dcmplx(1.d0,0.d0)
741 
742  z_rho = z_drho(p3,p4)
743  pa(1)=p1(1)+p2(1)+p3(1)+p4(1) ! E
744  pa(2)=p1(2)+p2(2)+p3(2)+p4(2) !px
745  pa(3)=p1(3)+p2(3)+p3(3)+p4(3) !py
746  pa(4)=p1(4)+p2(4)+p3(4)+p4(4) !pz
747 
748  som = (pa(1)-p1(1))**2 - (pa(2)-p1(2))**2 -
749  $ (pa(3)-p1(3))**2 - (pa(4)-p1(4))**2
750 
751  fs = 1.0d0
752  z_a1 = z_domega(som)
753 
754  fcom = fs/(z_a1*z_rho)
755  pp2 = scalar(pa,p2)
756  pp3 = scalar(pa,p3)
757  pp4 = scalar(pa,p4)
758  p1p2= scalar(p1,p2)
759  p1p3= scalar(p1,p3)
760  p1p4= scalar(p1,p4)
761  do i=1,4
762  z_vec(i)=fcom*(p2(i)*(pp3*p1p4-pp4*p1p3)-pp2*(p3(i)*p1p4-
763  $ p4(i)*p1p3) + p1p2*(p3(i)*pp4-p4(i)*pp3)) * zmix
764  enddo
765 C Changing 4 vector convention to (x,y,z,e) like in TAUOLA
766  z_ee=z_vec(1)
767  do i=1,3
768  z_vec(i) = z_vec(i+1)
769  enddo
770  z_vec(4)= z_ee
771  end
772 
773  complex*16 function z_domega(som)
774 C Calculation of Omega propagator : ee-> pi0(q) + Omega(pi(p3),Rho)
775 C Eq.(18) from hep-ph/0201149 and points 2,4 from internal note
776 C p_q - pion with Omega
777 C p1,p2 - pions from Rho
778 C p3 - pion from Omega
779 C
780  implicit none
781  real*8 AMass_O,Gamma_O
782  real*8 som,gom,gomega
783  common /omega/amass_o
784 
785  data gamma_o /0.00841d0/
786  data amass_o /0.782d0/
787 
788  gom = gomega(sqrt(som))
789  z_domega = dcmplx(som/(amass_o**2)-1.d0,gamma_o/amass_o*gom)
790  end
791  real*8 function gomega(x)
792 C Evolution of width of omega (see Eq.(7) from internal note)
793  implicit none
794  real*8 x
795  real*8 AMass_O,PAR(10)
796  common /omega/amass_o
797  data par/17.5598888d0,141.110153d0,894.884460d0,4977.35107d0,
798  #7610.65625d0,-42524.4062d0,-1333.26282d0,4860.18799d0,
799  #-6000.80908d0,2504.97461d0/
800  if (x.le.1.) then
801  gomega = 1. + par(1)*(x-0.782)+par(2)*(x-0.782)**2
802  # +par(3)*(x-0.782)**3+par(4)*(x-0.782)**4+par(5)*(x-0.782)**5
803  # +par(6)*(x-0.782)**6
804  else
805  gomega = par(7)+par(8)*x+par(9)*x**2+par(10)*x**3
806  endif
807  gomega = max(0.d0,gomega)
808  end
809 
810  REAL FUNCTION zfa1tab(Q2)
811 C Tabulated value of complex function, describing the energy
812 C dependence of the cross section e+e- -> a1 pi -> 2pi+ 2pi- (see comments
813 C in internal note - just below Eq.(3) )
814  IMPLICIT NONE
815  INTEGER I
816  REAL*8 DELTA
817  REAL Q2
818  REAL S(100),VAL(100)
819  SAVE s,val
820  DATA s/ 0.2916000,0.3206586,0.3497172,0.3787757,
821  # 0.4078344,0.4368929,0.4659515,0.4950101,0.5240687,0.5531273,
822  # 0.5821859,0.6112444,0.6403030,0.6693616,0.6984202,0.7274788,
823  # 0.7565374,0.7855960,0.8146545,0.8437131,0.8727717,0.9018303,
824  # 0.9308889,0.9599475,0.9890060,1.0180646,1.0471232,1.0761818,
825  # 1.1052403,1.1342990,1.1633576,1.1924162,1.2214748,1.2505333,
826  # 1.2795919,1.3086505,1.3377091,1.3667676,1.3958262,1.4248848,
827  # 1.4539435,1.4830021,1.5120606,1.5411192,1.5701778,1.5992364,
828  # 1.6282949,1.6573535,1.6864121,1.7154707,1.7445292,1.7735878,
829  # 1.8026465,1.8317051,1.8607637,1.8898222,1.9188808,1.9479394,
830  # 1.9769980,2.0060565,2.0351152,2.0641737,2.0932324,2.1222908,
831  # 2.1513495,2.1804080,2.2094667,2.2385252,2.2675838,2.2966425,
832  # 2.3257010,2.3547597,2.3838181,2.4128768,2.4419353,2.4709940,
833  # 2.5000525,2.5291111,2.5581696,2.5872283,2.6162868,2.6453454,
834  # 2.6744041,2.7034626,2.7325213,2.7615798,2.7906384,2.8196969,
835  # 2.8487556,2.8778141,2.9068727,2.9359312,2.9649899,2.9940486,
836  # 3.0231071,3.0521657,3.0812242,3.1102829,3.1393414,3.1684000/
837  DATA val/ 2.0261996,2.2349865,2.4839740,2.7840748,
838  # 3.1488798,3.5936222,4.1301847,4.7517977,5.3984838,5.9147439,
839  # 6.0864558,5.8283591,5.2841811,4.6615186,4.0839195,3.5914702,
840  # 3.1841860,2.8494759,2.5732665,2.3434010,2.1502059,1.9862038,
841  # 1.8456544,1.7241427,1.6182493,1.5253036,1.4432002,1.3702650,
842  # 1.3051554,1.2467849,1.1942677,1.1468738,1.1039963,1.0651271,
843  # 1.0298390,0.9977714,0.9686196,0.9421255,0.9180685,0.8962603,
844  # 0.8765374,0.8587573,0.8427927,0.8285285,0.8158574,0.8046767,
845  # 0.7948853,0.7863811,0.7790571,0.7728010,0.7674922,0.7630011,
846  # 0.7591889,0.7559078,0.7530031,0.7503147,0.7476809,0.7449428,
847  # 0.7419487,0.7385587,0.7346500,0.7301207,0.7248930,0.7189151,
848  # 0.7121620,0.7046344,0.6963565,0.6873729,0.6777444,0.6675445,
849  # 0.6568548,0.6457604,0.6343476,0.6227004,0.6108983,0.5990148,
850  # 0.5871165,0.5752623,0.5635037,0.5518846,0.5404415,0.5292045,
851  # 0.5181981,0.5074410,0.4969472,0.4867267,0.4767860,0.4671288,
852  # 0.4577557,0.4486661,0.4398569,0.4313242,0.4230627,0.4150662,
853  # 0.4073282,0.3998415,0.3925985,0.3855914,0.3788125,0.3722538/
854 
855 
856  delta = (s(100)-s(1))/99.d0
857  i = int((q2-s(1))/delta) + 1
858 
859  zfa1tab = val(i) + (val(i+1)-val(i))/(s(i+1)-s(i))*(q2-s(i))
860  END
861 
862  REAL FUNCTION fit_a1_1(E)
863 C Tabulated fit function for chanel 2pi+ pi- pi0
864 C (contribution from a1 -> 3pi),
865 C it is a part of G_pi+_pi-_pi+_pi0(Q^2) function.
866  IMPLICIT NONE
867  INTEGER I
868  REAL E,FIT
869  REAL ARG(98),VAL(98)
870  SAVE arg,val
871  DATA arg/ 0.6000000,0.6131313,0.6262626,0.6393939,
872  # 0.6525252,0.6656566,0.6787879,0.6919192,0.7050505,0.7181818,
873  # 0.7313131,0.7444444,0.7575758,0.7707071,0.7838384,0.7969697,
874  # 0.8101010,0.8232324,0.8363636,0.8494949,0.8626263,0.8757576,
875  # 0.8888889,0.9020202,0.9151515,0.9282829,0.9414141,0.9545454,
876  # 0.9676768,0.9808081,0.9939394,1.0070707,1.0202020,1.0333333,
877  # 1.0464647,1.0595959,1.0727273,1.0858586,1.0989898,1.1121212,
878  # 1.1252525,1.1383839,1.1515151,1.1646465,1.1777778,1.1909091,
879  # 1.2040404,1.2171717,1.2303030,1.2434343,1.2565657,1.2696970,
880  # 1.2828283,1.2959596,1.3090909,1.3222222,1.3353535,1.3484849,
881  # 1.3616161,1.3747475,1.3878788,1.4010102,1.4141414,1.4272727,
882  # 1.4404041,1.4535353,1.4666667,1.4797980,1.4929293,1.5060606,
883  # 1.5191919,1.5323232,1.5454545,1.5585859,1.5717171,1.5848485,
884  # 1.5979798,1.6111112,1.6242424,1.6373737,1.6505051,1.6636363,
885  # 1.6767677,1.6898990,1.7030303,1.7161616,1.7292930,1.7424242,
886  # 1.7555555,1.7686869,1.7818182,1.7949495,1.8080808,1.8212122,
887  # 1.8343434,1.8474747,1.8606061,1.8737373/
888  DATA val/ 0.0000000, 0.0000000, 0.0000000, 0.0000000,
889  # 0.0000000, 0.0000000, 0.0000000, 0.0000000, 0.0000000, 0.0000000,
890  # 0.0000000, 0.0000000, 0.0000000, 0.0000000, 0.0000000,13.1664906,
891  #10.7234087, 8.8219614,10.7989664, 9.1883001, 7.8526378, 7.7481031,
892  # 8.2633696, 5.5042820, 4.9029269, 4.4794345, 3.9654009, 4.5254011,
893  # 3.6509495, 3.5005512, 3.2274280, 3.1808922, 2.9925177, 2.6886659,
894  # 2.5195024, 2.4678771, 2.3540580, 2.2123868, 2.1103525, 2.0106986,
895  # 1.8792295, 1.8250662, 1.7068460, 1.6442842, 1.5503920, 1.4814349,
896  # 1.4225838, 1.3627135, 1.3205355, 1.2784383, 1.2387408, 1.1975995,
897  # 1.1633024, 1.1318133, 1.1114354, 1.0951439, 1.0691465, 1.0602311,
898  # 1.0392803, 1.0220672, 1.0154786, 1.0010130, 0.9908018, 0.9710845,
899  # 0.9602382, 0.9488459, 0.9316537, 0.9118049, 0.8920435, 0.8719332,
900  # 0.8520256, 0.8280582, 0.8064085, 0.7767881, 0.7570597, 0.7382626,
901  # 0.7100251, 0.6846500, 0.6666913, 0.6372250, 0.6162248, 0.6007728,
902  # 0.5799103, 0.5674670, 0.5446148, 0.5352115, 0.5128809, 0.4932536,
903  # 0.5310397, 0.8566489, 0.0000000, 0.0000000, 0.0000000, 0.0000000,
904  # 0.0000000, 0.0000000, 0.0000000, 0.0000000/
905 
906  if (e.lt.0.6) then
907  fit=0.
908  elseif(e.lt.1.777) then
909  do i=98,1,-1
910  if (arg(i).le.e) goto 100
911  enddo
912  100 fit=val(i)+(val(i+1)-val(i))/(arg(i+1)-arg(i))*(e-arg(i))
913  else
914  fit=0.
915  endif
916  fit_a1_1=fit
917  END
918  REAL FUNCTION fit_om_1(E)
919 C Tabulated fit function for chanel 2pi+ pi- pi0
920 C (contribution from omega -> 3pi),
921 C it is a part of G^{omega}_pi+_pi-_pi+_pi0(Q^2) function.
922  IMPLICIT NONE
923  INTEGER I
924  REAL E,FIT
925  REAL ARG(98),VAL(98)
926  SAVE arg,val
927  DATA arg/ 0.6000000,0.6131313,0.6262626,0.6393939,
928  # 0.6525252,0.6656566,0.6787879,0.6919192,0.7050505,0.7181818,
929  # 0.7313131,0.7444444,0.7575758,0.7707071,0.7838384,0.7969697,
930  # 0.8101010,0.8232324,0.8363636,0.8494949,0.8626263,0.8757576,
931  # 0.8888889,0.9020202,0.9151515,0.9282829,0.9414141,0.9545454,
932  # 0.9676768,0.9808081,0.9939394,1.0070707,1.0202020,1.0333333,
933  # 1.0464647,1.0595959,1.0727273,1.0858586,1.0989898,1.1121212,
934  # 1.1252525,1.1383839,1.1515151,1.1646465,1.1777778,1.1909091,
935  # 1.2040404,1.2171717,1.2303030,1.2434343,1.2565657,1.2696970,
936  # 1.2828283,1.2959596,1.3090909,1.3222222,1.3353535,1.3484849,
937  # 1.3616161,1.3747475,1.3878788,1.4010102,1.4141414,1.4272727,
938  # 1.4404041,1.4535353,1.4666667,1.4797980,1.4929293,1.5060606,
939  # 1.5191919,1.5323232,1.5454545,1.5585859,1.5717171,1.5848485,
940  # 1.5979798,1.6111112,1.6242424,1.6373737,1.6505051,1.6636363,
941  # 1.6767677,1.6898990,1.7030303,1.7161616,1.7292930,1.7424242,
942  # 1.7555555,1.7686869,1.7818182,1.7949495,1.8080808,1.8212122,
943  # 1.8343434,1.8474747,1.8606061,1.8737373/
944  DATA val/ 0.0000000, 0.0000000, 0.0000000, 0.0000000,
945  # 0.0000000, 0.0000000, 0.0000000, 0.0000000, 0.0000000, 0.0000000,
946  # 0.0000000, 0.0000000, 0.0000000, 0.0000000, 0.0000000, 0.0000000,
947  # 0.0000000, 0.0000000, 0.0000000, 0.0000000, 0.0000000, 0.0000000,
948  # 0.0000000, 0.0000000, 2.2867811, 2.9710648, 2.9344304, 2.6913538,
949  # 2.5471206, 2.3557470, 2.2448280, 2.1074708, 2.0504866, 1.9270257,
950  # 1.8669430, 1.7907301, 1.7184515, 1.6535717, 1.6039416, 1.5535343,
951  # 1.5065620, 1.4608675, 1.4215596, 1.3849826, 1.3480113, 1.3147917,
952  # 1.2793381, 1.2487282, 1.2184237, 1.1952927, 1.1683835, 1.1458827,
953  # 1.1145806, 1.0935820, 1.0608720, 1.0390474, 1.0164336, 0.9908721,
954  # 0.9585276, 0.9307971, 0.9017274, 0.8731154, 0.8452763, 0.8145532,
955  # 0.7817339, 0.7493086, 0.7199919, 0.6887290, 0.6568120, 0.6255773,
956  # 0.5944664, 0.5661956, 0.5391204, 0.5102391, 0.4786543, 0.4546428,
957  # 0.4316779, 0.4063754, 0.3769831, 0.3561141, 0.3333555, 0.3139160,
958  # 0.2949214, 0.2814728, 0.2602444, 0.2349602, 0.2269845, 0.2192318,
959  # 0.2286938, 0.2839763, 0.0000000, 0.0000000, 0.0000000, 0.0000000,
960  # 0.0000000, 0.0000000, 0.0000000, 0.0000000/
961 
962  if (e.lt.0.6) then
963  fit=0.
964  elseif(e.lt.1.777) then
965  do i=98,1,-1
966  if (arg(i).le.e) goto 100
967  enddo
968  100 fit=val(i)+(val(i+1)-val(i))/(arg(i+1)-arg(i))*(e-arg(i))
969  else
970  fit=0.
971  endif
972  fit_om_1=fit
973  END
974  REAL FUNCTION fit_2(E)
975 C Tabulated fit function for chanel tau- -> pi- 3pi0,
976 C it is a part of G_pi-_pi0_pi0_pi0(Q^2) function.
977  IMPLICIT NONE
978  INTEGER I
979  REAL E,FIT
980  REAL ARG(98),VAL(98)
981  SAVE arg,val
982  DATA arg/ 0.6000000,0.6131313,0.6262626,0.6393939,
983  # 0.6525252,0.6656566,0.6787879,0.6919192,0.7050505,0.7181818,
984  # 0.7313131,0.7444444,0.7575758,0.7707071,0.7838384,0.7969697,
985  # 0.8101010,0.8232324,0.8363636,0.8494949,0.8626263,0.8757576,
986  # 0.8888889,0.9020202,0.9151515,0.9282829,0.9414141,0.9545454,
987  # 0.9676768,0.9808081,0.9939394,1.0070707,1.0202020,1.0333333,
988  # 1.0464647,1.0595959,1.0727273,1.0858586,1.0989898,1.1121212,
989  # 1.1252525,1.1383839,1.1515151,1.1646465,1.1777778,1.1909091,
990  # 1.2040404,1.2171717,1.2303030,1.2434343,1.2565657,1.2696970,
991  # 1.2828283,1.2959596,1.3090909,1.3222222,1.3353535,1.3484849,
992  # 1.3616161,1.3747475,1.3878788,1.4010102,1.4141414,1.4272727,
993  # 1.4404041,1.4535353,1.4666667,1.4797980,1.4929293,1.5060606,
994  # 1.5191919,1.5323232,1.5454545,1.5585859,1.5717171,1.5848485,
995  # 1.5979798,1.6111112,1.6242424,1.6373737,1.6505051,1.6636363,
996  # 1.6767677,1.6898990,1.7030303,1.7161616,1.7292930,1.7424242,
997  # 1.7555555,1.7686869,1.7818182,1.7949495,1.8080808,1.8212122,
998  # 1.8343434,1.8474747,1.8606061,1.8737373/
999  DATA val/ 0.0000000, 0.0000000, 0.0000000, 0.0000000,
1000  # 0.0000000, 0.0000000, 0.0000000, 0.0000000, 0.0000000, 0.0000000,
1001  # 0.0000000, 0.0000000, 0.0000000, 0.0000000, 0.0000000, 1.4819183,
1002  # 1.7086354, 1.6958492, 1.6172935, 1.6301320, 1.5719706, 1.5459771,
1003  # 1.5377471, 1.5008864, 1.4924121, 1.4720882, 1.4371741, 1.3990080,
1004  # 1.3879193, 1.4030601, 1.3768673, 1.3493533, 1.3547127, 1.3275831,
1005  # 1.3167892, 1.3035913, 1.2968298, 1.2801558, 1.2650299, 1.2557997,
1006  # 1.2325822, 1.2210644, 1.1935984, 1.1746194, 1.1510350, 1.1358515,
1007  # 1.1205584, 1.1010553, 1.0903869, 1.0731295, 1.0578678, 1.0438409,
1008  # 1.0377911, 1.0253277, 1.0103551, 1.0042409, 0.9937978, 0.9858117,
1009  # 0.9770346, 0.9724492, 0.9656686, 0.9606671, 0.9525813, 0.9488522,
1010  # 0.9417335, 0.9399430, 0.9323438, 0.9281269, 0.9244171, 0.9237418,
1011  # 0.9174354, 0.9177181, 0.9120840, 0.9047825, 0.9065579, 0.9034142,
1012  # 0.8992961, 0.9011586, 0.9036470, 0.8954964, 0.8898208, 0.8911991,
1013  # 0.8854824, 0.8888282, 0.8868449, 0.9004632, 0.8981572, 0.9096183,
1014  # 0.9046990, 1.7454215, 0.0000000, 0.0000000, 0.0000000, 0.0000000,
1015  # 0.0000000, 0.0000000, 0.0000000, 0.0000000/
1016 
1017  if (e.lt.0.6) then
1018  fit=0.
1019  elseif(e.lt.1.777) then
1020  do i=98,1,-1
1021  if (arg(i).le.e) goto 100
1022  enddo
1023  100 fit=val(i)+(val(i+1)-val(i))/(arg(i+1)-arg(i))*(e-arg(i))
1024  else
1025  fit=0.
1026  endif
1027  fit_2=fit
1028  END