10 IMPLICIT DOUBLE PRECISION(a-
h, o-
z)
15 common/
pydat1/mstu(200),paru(200),mstj(200),parj(200)
16 common/
pydat2/kchg(500,4),pmas(500,4),parf(2000),vckm(4,4)
23 DO 110 jt=1,
mstp(126)+10
50 pz=sqrt(sqlam)/(2d0*
vint(1))
57 IF(
mint(16+jt).LE.0.AND.(
mint(10+jt).NE.22.OR.
58 &
mint(106+jt).NE.3))
THEN
63 p(
n,3)=
pz*(-1)**(jt+1)
69 IF(kfh.EQ.113.AND.
mint(10+jt).EQ.22.AND.
mstp(102).EQ.1)
THEN
71 dbetaz=
p(
n,3)/sqrt(
p(
n,3)**2+
p(
n,5)**2)
75 IF(
n.EQ.nsav+2.AND.iabs(
k(nsav+1,2)).EQ.211)
THEN
77 CALL
pyrobo(nsav+1,nsav+2,0d0,-
phi,0d0,0d0,0d0)
79 CALL
pyrobo(nsav+1,nsav+2,-the,0d0,0d0,0d0,0d0)
80 140 cthe=2d0*
pyr(0)-1d0
88 eps=1d0/(1d0+(
vint(309)**2*(1d0-2d0*beamas**2/
90 & ebeamenucl**2)*(1d0-
vint(309)-
91 & (
vint(307)/4d0/ebeamenucl**2))))
92 r0400=
eps*r_rho / ( 1. +
eps * r_rho)
93 w_ang=0.75d0*(1.d0-r0400+(3.d0*r0400-1.d0)*cthe**2.)
94 if( r0400 .le. 1.d0/3.d0 )
then
99 w_ang_max= 0.75d0*(1.d0-r0400+(3.d0*r0400-1.d0)
101 IF(
pyr(0).gt.w_ang/w_ang_max) goto 140
103 CALL
pyrobo(nsav+1,nsav+2,acos(cthe),
phi,0d0,0d0,0d0)
105 CALL
pyrobo(nsav,nsav+2,0d0,0d0,0d0,0d0,dbetaz)
115 pmmas=sqrt(
vint(62+jt))
121 CALL
pyspli(kfh,21,kfl1,kfl2)
122 CALL
pykfdi(kfl1,0,kfl3,kf1)
123 IF(kf1.EQ.0) goto 150
124 CALL
pykfdi(kfl2,-kfl3,kfldum,kf2)
125 IF(kf2.EQ.0) goto 150
132 IF(pm1+pm2+parj(64).GT.pmmas) goto 150
137 pzp=sqrt(
max(0d0,(pmmas**2-pm1**2-pm2**2)**2-
138 & 4d0*pm1**2*pm2**2))/(2d0*pmmas)
141 p(
n-1,4)=sqrt(pm1**2+pzp**2)
142 p(
n,4)=sqrt(pm2**2+pzp**2)
145 dbetaz=
pz*(-1)**(jt+1)/sqrt(
pz**2+pmmas**2)
146 CALL
pyrobo(
n-1,
n,0d0,0d0,0d0,0d0,dbetaz)
149 ELSEIF(
mstp(101).EQ.1.OR.(
mstp(101).EQ.3.AND.
pyr(0).LT.
161 sqlam=(
vint(62+jt)-
p(
n-1,5)**2-
p(
n,5)**2)**2-
162 & 4d0*
p(
n-1,5)**2*
p(
n,5)**2
163 p(
n-1,3)=(pe*sqrt(sqlam)+
pz*(
vint(62+jt)+
p(
n-1,5)**2-
164 &
p(
n,5)**2))/(2d0*
vint(62+jt))*(-1)**(jt+1)
165 p(
n-1,4)=sqrt(
p(
n-1,3)**2+
p(
n-1,5)**2)
166 p(
n,3)=
pz*(-1)**(jt+1)-
p(
n-1,3)
167 p(
n,4)=sqrt(
p(
n,3)**2+
p(
n,5)**2)
187 IF(mod(kfh/1000,10).NE.0) imb=2
189 IF(
mstp(92).LE.1)
THEN
190 IF(imb.EQ.1) chi=
pyr(0)
191 IF(imb.EQ.2) chi=1d0-sqrt(
pyr(0))
192 ELSEIF(
mstp(92).EQ.2)
THEN
193 chi=1d0-
pyr(0)**(1d0/(1d0+chik))
194 ELSEIF(
mstp(92).EQ.3)
THEN
195 cut=2d0*0.3d0/
vint(1)
197 IF((chi**2/(chi**2+cut**2))**0.25d0*(1d0-chi)**chik.LT.
199 ELSEIF(
mstp(92).EQ.4)
THEN
200 cut=2d0*0.3d0/
vint(1)
201 cutr=(1d0+sqrt(1d0+cut**2))/cut
202 180 chir=cut*cutr**
pyr(0)
203 chi=(chir**2-cut**2)/(2d0*chir)
204 IF((1d0-chi)**chik.LT.
pyr(0)) goto 180
206 cut=2d0*0.3d0/
vint(1)
207 cuta=cut**(1d0-
parp(98))
208 cutb=(1d0+cut)**(1d0-
parp(98))
209 190 chi=(cuta+
pyr(0)*(cutb-cuta))**(1d0/(1d0-
parp(98)))
210 IF(((chi+cut)**2/(2d0*(chi**2+cut**2)))**
211 & (0.5d0*
parp(98))*(1d0-chi)**chik.LT.
pyr(0)) goto 190
213 IF(chi.LT.
p(
n,5)**2/
vint(62+jt).OR.chi.GT.1d0-
p(
n-2,5)**2/
214 &
vint(62+jt)) goto 160
215 sqm=
p(
n-2,5)**2/(1d0-chi)+
p(
n,5)**2/chi
216 pzi=(pe*(
vint(62+jt)-sqm)+
pz*(
vint(62+jt)+sqm))/
219 pqqp=(1d0-chi)*(pei+pzi)
220 p(
n-2,3)=0.5d0*(pqqp-
p(
n-2,5)**2/pqqp)*(-1)**(jt+1)
221 p(
n-2,4)=sqrt(
p(
n-2,3)**2+
p(
n-2,5)**2)
222 p(
n-1,4)=0.5d0*(
vint(62+jt)-sqm)/(pei+pzi)
223 p(
n-1,3)=
p(
n-1,4)*(-1)**jt
224 p(
n,3)=pzi*(-1)**(jt+1)-
p(
n-2,3)
225 p(
n,4)=sqrt(
p(
n,3)**2+
p(
n,5)**2)
230 IF(
mint(16+jt).EQ.0)
k(
i+2,2)=kfh
231 IF(
mint(16+jt).NE.0.OR.(
mint(10+jt).EQ.22.AND.
232 &
mint(106+jt).EQ.3))
k(
i+2,2)=isign(9900000,kfh)+10*(kfh/10)
234 p(
i+2,3)=
pz*(-1)**(jt+1)
236 p(
i+2,5)=sqrt(
vint(62+jt))
240 IF(
vint(23).LT.0.9d0)
THEN