9 COMMON / parmas / amtau,amnuta,amel,amnue,ammu,amnumu
10 * ,ampiz,ampi,amro,gamro,ama1,gama1
11 * ,amk,amkz,amkst,gamkst
13 REAL*4 amtau,amnuta,amel,amnue,ammu,amnumu
14 * ,ampiz,ampi,amro,gamro,ama1,gama1
15 * ,amk,amkz,amkst,gamkst
17 COMMON / decpar / gfermi,gv,ga,ccabib,scabib,gamel
18 REAL*4 gfermi,gv,ga,ccabib,scabib,gamel
20 xlam(x,y,z)=sqrt(abs((x-y-z)**2-4.0*y*z))
21 DATA pi /3.141592653589793238462643/
31 wyni= 1.0d0/4.0d0/amtau**2*(1-ama2**2/amtau**2)**2
32 wyni=wyni*(1+2*ama2**2/amtau**2)*carb**2*ama2**4/ama2/gama2*pi
33 dwpynd=xlam(ama2**2,amro**2,amom**2)/ama2
34 eff=dwpynd/ama2*(0.5*dwpynd**2*(1d0/amro**2+1d0/amom**2)+6)
36 gam3pi= 1d0/3.0d0/128d0/(2*pi)**3*amom**7*
37 $ (fomega*gropp/amro**2)**2/120d0
38 gam2pi= gropp**2/48d0/pi*amro
39 wyni=wyni* gam3pi/gamom
40 wyni=wyni* gam2pi/gamro
42 write(*,*)
'testresu=',wyni
45 SUBROUTINE curr5(MNUM,PIM1,PIM2,PIM3,PIM4,PIM5,HADCUR)
46 REAL pim1(4),pim2(4),pim3(4),pim4(4),pim5(4)
47 COMPLEX hadcur(4), hadcu(4)
49 CALL curr5x(mnum,pim1,pim2,pim3,pim4,pim5,hadcu)
53 ELSEIF (mnum.EQ.26)
THEN
54 CALL curr5x(mnum,pim2,pim3,pim1,pim4,pim5,hadcu)
58 CALL curr5x(mnum,pim4,pim5,pim2,pim3,pim1,hadcu)
60 hadcur(k)=hadcur(k)+hadcu(k)
62 CALL curr5x(mnum,pim4,pim5,pim3,pim2,pim1,hadcu)
64 hadcur(k)=hadcur(k)+hadcu(k)
67 CALL curr5x(24,pim2,pim3,pim1,pim4,pim5,hadcu)
69 hadcur(k)=hadcu(k) +hadcur(k)
71 CALL curr5x(24,pim2,pim3,pim1,pim5,pim4,hadcu)
73 hadcur(k)=hadcur(k)+hadcu(k)
75 CALL curr5x(24,pim3,pim2,pim1,pim4,pim5,hadcu)
77 hadcur(k)=hadcur(k)+hadcu(k)
79 CALL curr5x(24,pim3,pim2,pim1,pim5,pim4,hadcu)
81 hadcur(k)=hadcur(k)+hadcu(k)
85 hadcur(k)=hadcur(k)*sqrt(0.25)
87 ELSEIF (mnum.EQ.27)
THEN
88 CALL curr5x(mnum,pim2,pim3,pim1,pim4,pim5,hadcu)
92 CALL curr5x(mnum,pim2,pim4,pim1,pim3,pim5,hadcu)
94 hadcur(k)=hadcur(k)+hadcu(k)
96 CALL curr5x(mnum,pim2,pim5,pim1,pim3,pim4,hadcu)
98 hadcur(k)=hadcur(k)+hadcu(k)
100 CALL curr5x(mnum,pim4,pim3,pim1,pim2,pim5,hadcu)
102 hadcur(k)=hadcur(k)+hadcu(k)
104 CALL curr5x(mnum,pim5,pim3,pim1,pim4,pim2,hadcu)
106 hadcur(k)=hadcur(k)+hadcu(k)
108 CALL curr5x(mnum,pim5,pim4,pim1,pim3,pim2,hadcu)
110 hadcur(k)=hadcur(k)+hadcu(k)
113 hadcur(k)=hadcur(k)*sqrt(1.0/24.0)
115 ELSEIF (mnum.EQ.28)
THEN
116 CALL curr5x(mnum,pim4,pim5,pim2,pim3,pim1,hadcu)
120 CALL curr5x(mnum,pim1,pim5,pim2,pim3,pim4,hadcu)
122 hadcur(k)=hadcur(k)+hadcu(k)
124 CALL curr5x(mnum,pim1,pim4,pim2,pim3,pim5,hadcu)
126 hadcur(k)=hadcur(k)+hadcu(k)
128 CALL curr5x(mnum,pim4,pim5,pim3,pim2,pim1,hadcu)
130 hadcur(k)=hadcur(k)+hadcu(k)
132 CALL curr5x(mnum,pim1,pim5,pim3,pim2,pim4,hadcu)
134 hadcur(k)=hadcur(k)+hadcu(k)
136 CALL curr5x(mnum,pim1,pim4,pim3,pim2,pim5,hadcu)
138 hadcur(k)=hadcur(k)+hadcu(k)
141 hadcur(k)=hadcur(k)*sqrt(1.0/12.0)
145 CALL curr5x(mnum,pim1,pim2,pim3,pim4,pim5,hadcu)
152 SUBROUTINE curr5x(MNUM,PIM1,PIM2,PIM3,PIM4,PIM5,HADCUR)
157 COMMON / parmas / amtau,amnuta,amel,amnue,ammu,amnumu
158 * ,ampiz,ampi,amro,gamro,ama1,gama1
159 * ,amk,amkz,amkst,gamkst
161 REAL*4 amtau,amnuta,amel,amnue,ammu,amnumu
162 * ,ampiz,ampi,amro,gamro,ama1,gama1
163 * ,amk,amkz,amkst,gamkst
165 REAL pim1(4),pim2(4),pim3(4),pim4(4),pim5(4)
168 INTEGER k,l,mnum,k1,k2,iro,i,j,kk
169 REAL pa(4),pb(4),paa(4),pc(4),pd(4)
171 REAL a,xm,xg,g1,g2,g,amro2,gamro2,amro3,gamro3,amom,gamom
172 REAL fro,coef1,fpi,coef2,qq,sk,denom,sig,qqa,ss23,ss24,ss34,qp1p2
173 REAL qp1p3,qp1p4,p1p2,p1p3,p1p4,sign
175 COMPLEX alf0,alf1,alf2,alf3
176 COMPLEX lam0,lam1,lam2,lam3
177 COMPLEX bet1,bet2,bet3
178 COMPLEX form1,form2,form3,form4,form2pi
179 COMPLEX bwigm,wigfor,fpikm,fpikmd
183 DATA pi /3.141592653589793238462643/
184 bwign(a,xm,xg)=xm**2/cmplx(a-xm**2,xm*xg)
186 sa1=(pim1(4)+pim2(4)+pim3(4)+pim4(4)+pim5(4))**2
187 $ -(pim1(3)+pim2(3)+pim3(3)+pim4(3)+pim5(3))**2
188 $ -(pim1(2)+pim2(2)+pim3(2)+pim4(2)+pim5(2))**2
189 $ -(pim1(1)+pim2(1)+pim3(1)+pim4(1)+pim5(1))**2
195 somega=(pim2(4)+pim3(4)+pim4(4))**2-(pim2(3)+pim3(3)+pim4(3))**2
196 $ -(pim2(2)+pim3(2)+pim4(2))**2-(pim2(1)+pim3(1)+pim4(1))**2
197 sp= (pim2(4)+pim4(4))**2-(pim2(3)+pim4(3))**2
198 $ -(pim2(2)+pim4(2))**2-(pim2(1)+pim4(1))**2
199 sm= (pim3(4)+pim4(4))**2-(pim3(3)+pim4(3))**2
200 $ -(pim3(2)+pim4(2))**2-(pim3(1)+pim4(1))**2
201 s0= (pim2(4)+pim3(4))**2-(pim2(3)+pim3(3))**2
202 $ -(pim2(2)+pim3(2))**2-(pim2(1)+pim3(1))**2
206 srho=(pim1(4)+pim5(4))**2-(pim1(3)+pim5(3))**2
207 $ -(pim1(2)+pim5(2))**2-(pim1(1)+pim5(1))**2
211 paa(k)=pim1(k)+pim2(k)+pim3(k)+pim4(k)+pim5(k)
212 pa(k) =pim2(k)+pim3(k)+pim4(k)
213 pb(k)=pim1(k)-pim5(k)
215 CALL levici(pc,pim2,pim3,pim4)
216 CALL levici(pd,pb,pc,paa)
228 coef1=carb/amro**2/amom**2* gropp* (fomega*gropp/amro**2)
230 hadcur(k)=coef1*pd(k)
231 hadcur(k)=hadcur(k)*bwign(somega,amom,gamom)
232 $ *bwign(srho,amro,gamro)*bwign(sa1,ama2,gama2)
236 ELSEIF (mnum.EQ.26.OR.mnum.EQ.27.OR.mnum.EQ.28)
THEN
243 sa2=(pim2(4)+pim3(4)+pim1(4))**2-(pim2(3)+pim3(3)+pim1(3))**2
244 $ -(pim2(2)+pim3(2)+pim1(2))**2-(pim2(1)+pim3(1)+pim1(1))**2
245 s2= (pim1(4)+pim3(4))**2-(pim1(3)+pim3(3))**2
246 $ -(pim1(2)+pim3(2))**2-(pim1(1)+pim3(1))**2
247 s1= (pim2(4)+pim3(4))**2-(pim2(3)+pim3(3))**2
248 $ -(pim2(2)+pim3(2))**2-(pim2(1)+pim3(1))**2
249 s2x13=pim2(4)*(pim1(4)-pim3(4))-pim2(3)*(pim1(3)-pim3(3))
250 $ -pim2(2)*(pim1(2)-pim3(2))-pim2(1)*(pim1(1)-pim3(1))
251 s1x23=pim1(4)*(pim2(4)-pim3(4))-pim1(3)*(pim2(3)-pim3(3))
252 $ -pim1(2)*(pim2(2)-pim3(2))-pim1(1)*(pim2(1)-pim3(1))
256 sf=(pim4(4)+pim5(4))**2-(pim4(3)+pim5(3))**2
257 $ -(pim4(2)+pim5(2))**2-(pim4(1)+pim5(1))**2
260 paa(k)=pim1(k)+pim2(k)+pim3(k)+pim4(k)+pim5(k)
261 pa(k) =pim1(k)+pim2(k)+pim3(k)
262 pb(k)=pa(k)*s2x13/sa2-(pim1(k)-pim3(k))
263 pc(k)=pa(k)*s1x23/sa2-(pim2(k)-pim3(k))
265 papb=paa(4)*pb(4)-paa(3)*pb(3)-paa(2)*pb(2)-paa(1)*pb(1)
266 papc=paa(4)*pc(4)-paa(3)*pc(3)-paa(2)*pc(2)-paa(1)*pc(1)
268 hadcur(k)=hadcur(k)+(paa(k)*papb/sa1-pb(k))*bwign(s2,amro,gamro)
269 hadcur(k)=hadcur(k)+(paa(k)*papc/sa1-pc(k))*bwign(s1,amro,gamro)
284 coef1=carb/ama2**4/amf2**2/amro**2*faaf*fpp* grorop* gropp
286 hadcur(k)=coef1*hadcur(k)
287 hadcur(k)=hadcur(k)*bwign(sf,amf2,gamf2)
288 $ *bwign(sa2,ama2,gama2)*bwign(sa1,ama2,gama2)
295 coef1=2*2.0*sqrt(3.0)/fpi**3
296 coef1= 1d0/amtau**3 *(4*3*2*1)* (4*pi)**3* sqrt(20.0d0)
303 paa(k)=pim1(k)+pim2(k)+pim3(k)+pim4(k)+pim5(k)
304 hadcur(k)=coef1*paa(k)
308 SUBROUTINE levici(P,A,B,C)
309 REAL p(4),a(4),b(4),c(4)
311 p(1)=a(2)*b(3)*c(4)+a(3)*b(4)*c(2)+a(4)*b(2)*c(3)
312 $ -a(2)*b(4)*c(3)-a(4)*b(3)*c(2)-a(3)*b(2)*c(4)
314 p(2)=a(1)*b(4)*c(3)+a(3)*b(1)*c(4)+a(4)*b(3)*c(1)
315 $ -a(1)*b(3)*c(4)-a(4)*b(1)*c(3)-a(3)*b(4)*c(1)
317 p(3)=a(1)*b(2)*c(4)+a(4)*b(1)*c(2)+a(2)*b(4)*c(1)
318 $ -a(1)*b(4)*c(2)-a(2)*b(1)*c(4)-a(4)*b(2)*c(1)
320 p(4)=a(1)*b(3)*c(2)+a(2)*b(1)*c(3)+a(3)*b(2)*c(1)
321 $ -a(1)*b(2)*c(3)-a(3)*b(1)*c(2)-a(2)*b(3)*c(1)
329 SUBROUTINE curr_cleo(MNUM,PIM1,PIM2,PIM3,PIM4,HADCUR)
340 COMMON / parmas / amtau,amnuta,amel,amnue,ammu,amnumu
341 * ,ampiz,ampi,amro,gamro,ama1,gama1
342 * ,amk,amkz,amkst,gamkst
344 REAL*4 amtau,amnuta,amel,amnue,ammu,amnumu
345 * ,ampiz,ampi,amro,gamro,ama1,gama1
346 * ,amk,amkz,amkst,gamkst
348 REAL pim1(4),pim2(4),pim3(4),pim4(4)
351 INTEGER k,l,mnum,k1,k2,iro,i,j,kk
352 REAL pa(4),pb(4),paa(4)
354 REAL a,xm,xg,g1,g2,g,amro2,gamro2,amro3,gamro3,amom,gamom
355 REAL fro,coef1,fpi,coef2,qq,sk,denom,sig,qqa,ss23,ss24,ss34,qp1p2
356 REAL qp1p3,qp1p4,p1p2,p1p3,p1p4,sign
358 COMPLEX alf0,alf1,alf2,alf3
359 COMPLEX lam0,lam1,lam2,lam3
360 COMPLEX bet1,bet2,bet3
361 COMPLEX form1,form2,form3,form4,form2pi
362 COMPLEX bwigm,wigfor,fpikm,fpikmd
366 bwign(a,xm,xg)=1.0/cmplx(a-xm**2,xm*xg)
370 IF (g1.NE.12.924)
THEN
376 coef1=2.0*sqrt(3.0)/fpi**2
394 ampl(1) = cmplx(pkorb(3,31)*coef1,0.)
395 ampl(2) = cmplx(pkorb(3,32)*coef1,0.)*cexp(cmplx(0.,pkorb(3,42)))
396 ampl(3) = cmplx(pkorb(3,33)*coef1,0.)*cexp(cmplx(0.,pkorb(3,43)))
397 ampl(4) = cmplx(pkorb(3,34)*coef1,0.)*cexp(cmplx(0.,pkorb(3,44)))
398 ampl(5) = cmplx(pkorb(3,35)*coef2,0.)*cexp(cmplx(0.,pkorb(3,45)))
400 ampl(6) = cmplx(pkorb(3,36)*coef1)
401 ampl(7) = cmplx(pkorb(3,37)*coef1)
404 alf0 = cmplx(pkorb(3,51),0.0)
405 alf1 = cmplx(pkorb(3,52)*amro**2,0.0)
406 alf2 = cmplx(pkorb(3,53)*amro2**2,0.0)
407 alf3 = cmplx(pkorb(3,54)*amro3**2,0.0)
409 lam0 = cmplx(pkorb(3,55),0.0)
410 lam1 = cmplx(pkorb(3,56)*amro**2,0.0)
411 lam2 = cmplx(pkorb(3,57)*amro2**2,0.0)
412 lam3 = cmplx(pkorb(3,58)*amro3**2,0.0)
414 bet1 = cmplx(pkorb(3,59)*amro**2,0.0)
415 bet2 = cmplx(pkorb(3,60)*amro2**2,0.0)
416 bet3 = cmplx(pkorb(3,61)*amro3**2,0.0)
426 paa(k)=pim1(k)+pim2(k)+pim3(k)+pim4(k)
438 qq=paa(4)**2-paa(3)**2-paa(2)**2-paa(1)**2
441 form4= lam0+lam1*bwign(qq,amro,gamro)
442 * +lam2*bwign(qq,amro2,gamro2)
443 * +lam3*bwign(qq,amro3,gamro3)
451 ELSEIF (k2.EQ.3)
THEN
455 ELSEIF (k1.EQ.3)
THEN
465 sk=(pp(k1,4)+pp(k2,4))**2-(pp(k1,3)+pp(k2,3))**2
466 $ -(pp(k1,2)+pp(k2,2))**2-(pp(k1,1)+pp(k2,1))**2
476 IF (l.NE.k1.AND.l.NE.k2)
THEN
477 denom=(paa(4)-pp(l,4))**2-(paa(3)-pp(l,3))**2
478 $ -(paa(2)-pp(l,2))**2-(paa(1)-pp(l,1))**2
484 $ -sig*(paa(i)-2.0*pp(l,i))*(paa(j)-pp(l,j))/denom
493 form2pi= bet1*bwigm(sk,amro,gamro,ampa,ampi)
494 1 +bet2*bwigm(sk,amro2,gamro2,ampa,ampi)
495 2 +bet3*bwigm(sk,amro3,gamro3,ampa,ampi)
496 form1= ampl(1)+ampr*form2pi
500 hadcur(i)=hadcur(i)+form1*form4*aa(i,j)*(pp(k1,j)-pp(k2,j))
508 IF (ampl(5).EQ.cmplx(0.,0.)) goto 311
513 form2=ampl(5)*(alf0+alf1*bwign(qq,amro,gamro)
514 * +alf2*bwign(qq,amro2,gamro2)
515 * +alf3*bwign(qq,amro3,gamro3))
537 IF (k.EQ.4) sign= 1.0
538 qqa=qqa+sign*(paa(k)-pa(k))**2
539 ss23=ss23+sign*(pb(k) +pim3(k))**2
540 ss24=ss24+sign*(pb(k) +pim4(k))**2
541 ss34=ss34+sign*(pim3(k)+pim4(k))**2
542 qp1p2=qp1p2+sign*(paa(k)-pa(k))*pb(k)
543 qp1p3=qp1p3+sign*(paa(k)-pa(k))*pim3(k)
544 qp1p4=qp1p4+sign*(paa(k)-pa(k))*pim4(k)
545 p1p2=p1p2+sign*pa(k)*pb(k)
546 p1p3=p1p3+sign*pa(k)*pim3(k)
547 p1p4=p1p4+sign*pa(k)*pim4(k)
554 form3=bwign(qqa,amom,gamom)
557 hadcur(k)=hadcur(k)+form2*form3*(
558 $ pb(k)*(qp1p3*p1p4-qp1p4*p1p3)
559 $ +pim3(k)*(qp1p4*p1p2-qp1p2*p1p4)
560 $ +pim4(k)*(qp1p2*p1p3-qp1p3*p1p2) )
570 qq=paa(4)**2-paa(3)**2-paa(2)**2-paa(1)**2
574 sk=(pp(k,4)+pim4(4))**2-(pp(k,3)+pim4(3))**2
575 $ -(pp(k,2)+pim4(2))**2-(pp(k,1)+pim4(1))**2
587 denom=(paa(4)-pp(l,4))**2-(paa(3)-pp(l,3))**2
588 $ -(paa(2)-pp(l,2))**2-(paa(1)-pp(l,1))**2
594 $ -sig*(paa(i)-2.0*pp(l,i))*(paa(j)-pp(l,j))/denom
603 form1 = ampl(6)+ampl(7)*fpikm(sqrt(sk),ampi,ampi)
607 hadcur(i)=hadcur(i)+form1*aa(i,j)*(pp(k,j)-pp(4,j))