11 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)
17 common/
pydat3/mdcy(500,3),mdme(8000,2),brat(8000),kfdp(8000,5)
20 common/
pyint4/mwid(500),wids(500,5)
23 CHARACTER chinl*120,chkf*9,chvar(22)*9,chlin*72,
24 &chblk(20)*72,chold*16,chtmp*16,chnew*16,chcom*24
25 DATA chvar/
'KCHG(I,1)',
'KCHG(I,2)',
'KCHG(I,3)',
'KCHG(I,4)',
26 &
'PMAS(I,1)',
'PMAS(I,2)',
'PMAS(I,3)',
'PMAS(I,4)',
'MDCY(I,1)',
27 &
'MDCY(I,2)',
'MDCY(I,3)',
'MDME(I,1)',
'MDME(I,2)',
'BRAT(I) ',
28 &
'KFDP(I,1)',
'KFDP(I,2)',
'KFDP(I,3)',
'KFDP(I,4)',
'KFDP(I,5)',
29 &
'CHAF(I,1)',
'CHAF(I,2)',
'MWID(I) '/
32 IF(mstu(12).NE.12345) CALL
pylist(0)
37 WRITE(lfn,5000) kchg(kc,4),(chaf(kc,j1),j1=1,2),
38 & (kchg(kc,j2),j2=1,3),(pmas(kc,j3),j3=1,4),
40 DO 100 idc=mdcy(kc,2),mdcy(kc,2)+mdcy(kc,3)-1
41 WRITE(lfn,5100) mdme(idc,1),mdme(idc,2),brat(idc),
48 ELSEIF(mupda.EQ.2.OR.mupda.EQ.3)
THEN
60 IF(kc.GT.100.AND.kchg(kc,4).GT.100) kcc=kc
61 ndc=
max(ndc,mdcy(kc,2)+mdcy(kc,3)-1)
67 140
READ(lfn,5200,
end=190) chinl
70 IF(chinl(2:10).NE.
' ')
THEN
86 IF(kchg(kcr,4).EQ.kf) kcrep=kcr
90 IF(kcrep.NE.0.AND.mdcy(kcrep,3).GT.0)
THEN
94 IF(mdcy(
i,2).GT.idcrep) mdcy(
i,2)=mdcy(
i,2)-ndcrep
96 DO 180
i=idcrep,ndc-ndcrep
97 mdme(
i,1)=mdme(
i+ndcrep,1)
98 mdme(
i,2)=mdme(
i+ndcrep,2)
99 brat(
i)=brat(
i+ndcrep)
101 kfdp(
i,
j)=kfdp(
i+ndcrep,
j)
106 ELSEIF(kcrep.NE.0)
THEN
115 IF(kc.GT.mstu(6)) CALL
pyerrm(27,
116 &
'(PYUPDA:) Particle arrays full by KF ='//chkf)
117 READ(chinl,5000) kchg(kc,4),(chaf(kc,j1),j1=1,2),
118 & (kchg(kc,j2),j2=1,3),(pmas(kc,j3),j3=1,4),
119 & mwid(kc),mdcy(kc,1)
126 IF(ndc.GT.mstu(7)) CALL
pyerrm(27,
127 &
'(PYUPDA:) Decay data arrays full by KF ='//chkf)
128 IF(mdcy(kc,2).EQ.0) mdcy(kc,2)=ndc
129 mdcy(kc,3)=mdcy(kc,3)+1
130 READ(chinl,5100) mdme(ndc,1),mdme(ndc,2),brat(ndc),
131 & (kfdp(ndc,
j),
j=1,5)
144 IF(min(pmas(kc,1),pmas(kc,2),pmas(kc,3),pmas(kc,1)-pmas(kc,3),
145 & pmas(kc,4)).LT.0d0.OR.mdcy(kc,3).LT.0) CALL
pyerrm(17,
146 &
'(PYUPDA:) Mass/width/life/(# channels) wrong for KF ='//chkf)
148 DO 210 idc=mdcy(kc,2),mdcy(kc,2)+mdcy(kc,3)-1
149 IF(mdme(idc,2).GT.80) goto 210
151 pms=pmas(kc,1)-pmas(kc,3)-parj(64)
155 IF(kp.EQ.0.OR.kp.EQ.81.OR.iabs(kp).EQ.82)
THEN
157 ELSEIF(
pycomp(kp).EQ.0)
THEN
163 IF(mstj(24).GT.0) pms=pms+0.5d0*min(pmas(kpc,2),
167 IF(kq.NE.0) merr=
max(2,merr)
168 IF(mwid(kc).EQ.0.AND.kf.NE.311.AND.pms.LT.0d0)
170 IF(merr.EQ.3) CALL
pyerrm(17,
171 &
'(PYUPDA:) Unknown particle code in decay of KF ='//chkf)
172 IF(merr.EQ.2) CALL
pyerrm(17,
173 &
'(PYUPDA:) Charge not conserved in decay of KF ='//chkf)
174 IF(merr.EQ.1) CALL
pyerrm(7,
175 &
'(PYUPDA:) Kinematically unallowed decay of KF ='//chkf)
176 brsum=brsum+brat(idc)
178 WRITE(chtmp,5500) brsum
179 IF(abs(brsum).GT.0.0005d0.AND.abs(brsum-1d0).GT.0.0005d0)
180 & CALL
pyerrm(7,
'(PYUPDA:) Sum of branching ratios is '//
181 & chtmp(9:16)//
' for KF ='//chkf)
185 ELSEIF(mupda.EQ.4)
THEN
191 IF(kchg(
i,4).NE.0)
THEN
193 ndc=
max(ndc,mdcy(
i,2)+mdcy(
i,3)-1)
200 IF(ivar.GE.12.AND.ivar.LE.19) ndim=mstu(7)
203 chlin(7:35)=
'DATA ('//chvar(ivar)//
',I= 1, )/'
209 IF(ivar.EQ.1)
WRITE(chtmp,5400) kchg(idim,1)
210 IF(ivar.EQ.2)
WRITE(chtmp,5400) kchg(idim,2)
211 IF(ivar.EQ.3)
WRITE(chtmp,5400) kchg(idim,3)
212 IF(ivar.EQ.4)
WRITE(chtmp,5400) kchg(idim,4)
213 IF(ivar.EQ.5)
WRITE(chtmp,5500) pmas(idim,1)
214 IF(ivar.EQ.6)
WRITE(chtmp,5500) pmas(idim,2)
215 IF(ivar.EQ.7)
WRITE(chtmp,5500) pmas(idim,3)
216 IF(ivar.EQ.8)
WRITE(chtmp,5500) pmas(idim,4)
217 IF(ivar.EQ.9)
WRITE(chtmp,5400) mdcy(idim,1)
218 IF(ivar.EQ.10)
WRITE(chtmp,5400) mdcy(idim,2)
219 IF(ivar.EQ.11)
WRITE(chtmp,5400) mdcy(idim,3)
220 IF(ivar.EQ.12)
WRITE(chtmp,5400) mdme(idim,1)
221 IF(ivar.EQ.13)
WRITE(chtmp,5400) mdme(idim,2)
222 IF(ivar.EQ.14)
WRITE(chtmp,5600) brat(idim)
223 IF(ivar.EQ.15)
WRITE(chtmp,5400) kfdp(idim,1)
224 IF(ivar.EQ.16)
WRITE(chtmp,5400) kfdp(idim,2)
225 IF(ivar.EQ.17)
WRITE(chtmp,5400) kfdp(idim,3)
226 IF(ivar.EQ.18)
WRITE(chtmp,5400) kfdp(idim,4)
227 IF(ivar.EQ.19)
WRITE(chtmp,5400) kfdp(idim,5)
228 IF(ivar.EQ.20) chtmp=chaf(idim,1)
229 IF(ivar.EQ.21) chtmp=chaf(idim,2)
230 IF(ivar.EQ.22)
WRITE(chtmp,5400) mwid(idim)
234 IF(idim.GT.kcc) chtmp=
' 0'
235 ELSEIF(ivar.LE.8)
THEN
236 IF(idim.GT.kcc) chtmp=
' 0.0'
237 ELSEIF(ivar.LE.11)
THEN
238 IF(idim.GT.kcc) chtmp=
' 0'
239 ELSEIF(ivar.LE.13)
THEN
240 IF(idim.GT.ndc) chtmp=
' 0'
241 ELSEIF(ivar.LE.14)
THEN
242 IF(idim.GT.ndc) chtmp=
' 0.0'
243 ELSEIF(ivar.LE.19)
THEN
244 IF(idim.GT.ndc) chtmp=
' 0'
245 ELSEIF(ivar.LE.21)
THEN
246 IF(idim.GT.kcc) chtmp=
' '
248 IF(idim.GT.kcc) chtmp=
' 0'
255 IF(chtmp(17-ll:17-ll).NE.
' ') llow=17-ll
256 IF(chtmp(ll:ll).NE.
' ') lhig=ll
258 chnew=chtmp(llow:lhig)//
' '
260 IF((ivar.GE.5.AND.ivar.LE.8).OR.ivar.EQ.14)
THEN
263 IF(lnew.GE.2.AND.chnew(lnew:lnew).EQ.
'0') goto 250
264 IF(chnew(lnew:lnew).EQ.
'.') lnew=lnew-1
269 chnew(lnew+1:lnew+2)=
'D0'
272 ELSEIF(ivar.EQ.20.OR.ivar.EQ.21)
THEN
274 IF(chnew(ll:ll).EQ.
'''')
THEN
276 chnew=chtmp(1:ll)//
''''//chtmp(ll+1:11)
282 chnew(1:lnew+2)=
''''//chtmp(1:lnew)//
''''
287 IF(chnew.NE.chold)
THEN
294 IF(nrpt.GE.2) lrpt=lnew+3
295 IF(nrpt.GE.10) lrpt=lnew+4
296 IF(nrpt.GE.100) lrpt=lnew+5
297 IF(nrpt.GE.1000) lrpt=lnew+6
300 WRITE(chtmp,5400) nrpt
302 IF(nrpt.GE.10) lrpt=2
303 IF(nrpt.GE.100) lrpt=3
304 IF(nrpt.GE.1000) lrpt=4
305 chcom(1:lrpt+1+lnew)=chtmp(17-lrpt:16)//
'*'//chnew(1:lnew)
311 IF(llin+lcom.LE.70)
THEN
312 chlin(llin+1:llin+lcom+1)=chcom(1:lcom)//
','
314 ELSEIF(nlin.LE.19)
THEN
318 chlin(6:6+lcom+1)=
'&'//chcom(1:lcom)//
','
321 chlin(llin:72)=
'/'//
' '
323 WRITE(chtmp,5400) idim-nrpt
324 chblk(1)(30:33)=chtmp(13:16)
326 WRITE(lfn,5700) chblk(ilin)
330 chlin(7:35+lcom+1)=
'DATA ('//chvar(ivar)//
331 &
',I= , )/'//chcom(1:lcom)//
','
332 WRITE(chtmp,5400) idim-nrpt+1
333 chlin(25:28)=chtmp(13:16)
339 chlin(llin:72)=
'/'//
' '
341 WRITE(chtmp,5400) ndim
342 chblk(1)(30:33)=chtmp(13:16)
344 WRITE(lfn,5700) chblk(ilin)
350 5000
FORMAT(1
x,i9,2
x,a16,2
x,a16,3
i3,3f12.5,1
p,e13.5,2
i3)
351 5100
FORMAT(10
x,2
i5,f12.6,5i10)