2 SUBROUTINE curr_cleo(MNUM,PIM1,PIM2,PIM3,PIM4,HADCUR)
13 COMMON / parmas / amtau,amnuta,amel,amnue,ammu,amnumu
14 * ,ampiz,ampi,amro,gamro,ama1,gama1
15 * ,amk,amkz,amkst,gamkst
17 REAL*4 amtau,amnuta,amel,amnue,ammu,amnumu
18 * ,ampiz,ampi,amro,gamro,ama1,gama1
19 * ,amk,amkz,amkst,gamkst
21 REAL pim1(4),pim2(4),pim3(4),pim4(4)
24 INTEGER k,l,mnum,k1,k2,iro,i,j,kk
25 REAL pa(4),pb(4),paa(4)
27 REAL a,xm,xg,g1,g2,g,amro2,gamro2,amro3,gamro3,amom,gamom
28 REAL fro,coef1,fpi,coef2,qq,sk,denom,sig,qqa,ss23,ss24,ss34,qp1p2
29 REAL qp1p3,qp1p4,p1p2,p1p3,p1p4,sign
31 COMPLEX alf0,alf1,alf2,alf3
32 COMPLEX lam0,lam1,lam2,lam3
33 COMPLEX bet1,bet2,bet3
34 COMPLEX form1,form2,form3,form4,form2pi
35 COMPLEX bwigm,wigfor,fpikm,fpikmd
39 bwign(a,xm,xg)=1.0/cmplx(a-xm**2,xm*xg)
43 IF (g1.NE.12.924)
THEN
49 coef1=2.0*sqrt(3.0)/fpi**2
67 ampl(1) = cmplx(pkorb(3,31)*coef1,0.)
68 ampl(2) = cmplx(pkorb(3,32)*coef1,0.)*cexp(cmplx(0.,pkorb(3,42)))
69 ampl(3) = cmplx(pkorb(3,33)*coef1,0.)*cexp(cmplx(0.,pkorb(3,43)))
70 ampl(4) = cmplx(pkorb(3,34)*coef1,0.)*cexp(cmplx(0.,pkorb(3,44)))
71 ampl(5) = cmplx(pkorb(3,35)*coef2,0.)*cexp(cmplx(0.,pkorb(3,45)))
73 ampl(6) = cmplx(pkorb(3,36)*coef1)
74 ampl(7) = cmplx(pkorb(3,37)*coef1)
77 alf0 = cmplx(pkorb(3,51),0.0)
78 alf1 = cmplx(pkorb(3,52)*amro**2,0.0)
79 alf2 = cmplx(pkorb(3,53)*amro2**2,0.0)
80 alf3 = cmplx(pkorb(3,54)*amro3**2,0.0)
82 lam0 = cmplx(pkorb(3,55),0.0)
83 lam1 = cmplx(pkorb(3,56)*amro**2,0.0)
84 lam2 = cmplx(pkorb(3,57)*amro2**2,0.0)
85 lam3 = cmplx(pkorb(3,58)*amro3**2,0.0)
87 bet1 = cmplx(pkorb(3,59)*amro**2,0.0)
88 bet2 = cmplx(pkorb(3,60)*amro2**2,0.0)
89 bet3 = cmplx(pkorb(3,61)*amro3**2,0.0)
99 paa(k)=pim1(k)+pim2(k)+pim3(k)+pim4(k)
109 qq=paa(4)**2-paa(3)**2-paa(2)**2-paa(1)**2
112 form4= lam0+lam1*bwign(qq,amro,gamro)
113 * +lam2*bwign(qq,amro2,gamro2)
114 * +lam3*bwign(qq,amro3,gamro3)
122 ELSEIF (k2.EQ.3)
THEN
126 ELSEIF (k1.EQ.3)
THEN
136 sk=(pp(k1,4)+pp(k2,4))**2-(pp(k1,3)+pp(k2,3))**2
137 $ -(pp(k1,2)+pp(k2,2))**2-(pp(k1,1)+pp(k2,1))**2
147 IF (l.NE.k1.AND.l.NE.k2)
THEN
148 denom=(paa(4)-pp(l,4))**2-(paa(3)-pp(l,3))**2
149 $ -(paa(2)-pp(l,2))**2-(paa(1)-pp(l,1))**2
155 $ -sig*(paa(i)-2.0*pp(l,i))*(paa(j)-pp(l,j))/denom
164 form2pi= bet1*bwigm(sk,amro,gamro,ampa,ampi)
165 1 +bet2*bwigm(sk,amro2,gamro2,ampa,ampi)
166 2 +bet3*bwigm(sk,amro3,gamro3,ampa,ampi)
167 form1= ampl(1)+ampr*form2pi
171 hadcur(i)=hadcur(i)+form1*form4*aa(i,j)*(pp(k1,j)-pp(k2,j))
179 IF (ampl(5).EQ.cmplx(0.,0.)) goto 311
184 form2=ampl(5)*(alf0+alf1*bwign(qq,amro,gamro)
185 * +alf2*bwign(qq,amro2,gamro2)
186 * +alf3*bwign(qq,amro3,gamro3))
208 IF (k.EQ.4) sign= 1.0
209 qqa=qqa+sign*(paa(k)-pa(k))**2
210 ss23=ss23+sign*(pb(k) +pim3(k))**2
211 ss24=ss24+sign*(pb(k) +pim4(k))**2
212 ss34=ss34+sign*(pim3(k)+pim4(k))**2
213 qp1p2=qp1p2+sign*(paa(k)-pa(k))*pb(k)
214 qp1p3=qp1p3+sign*(paa(k)-pa(k))*pim3(k)
215 qp1p4=qp1p4+sign*(paa(k)-pa(k))*pim4(k)
216 p1p2=p1p2+sign*pa(k)*pb(k)
217 p1p3=p1p3+sign*pa(k)*pim3(k)
218 p1p4=p1p4+sign*pa(k)*pim4(k)
225 form3=bwign(qqa,amom,gamom)
228 hadcur(k)=hadcur(k)+form2*form3*(
229 $ pb(k)*(qp1p3*p1p4-qp1p4*p1p3)
230 $ +pim3(k)*(qp1p4*p1p2-qp1p2*p1p4)
231 $ +pim4(k)*(qp1p2*p1p3-qp1p3*p1p2) )
240 qq=paa(4)**2-paa(3)**2-paa(2)**2-paa(1)**2
244 sk=(pp(k,4)+pim4(4))**2-(pp(k,3)+pim4(3))**2
245 $ -(pp(k,2)+pim4(2))**2-(pp(k,1)+pim4(1))**2
257 denom=(paa(4)-pp(l,4))**2-(paa(3)-pp(l,3))**2
258 $ -(paa(2)-pp(l,2))**2-(paa(1)-pp(l,1))**2
264 $ -sig*(paa(i)-2.0*pp(l,i))*(paa(j)-pp(l,j))/denom
273 form1 = ampl(6)+ampl(7)*fpikm(sqrt(sk),ampi,ampi)
277 hadcur(i)=hadcur(i)+form1*aa(i,j)*(pp(k,j)-pp(4,j))