]> git.uio.no Git - u/mrichter/AliRoot.git/blame - PYTHIA/jetset/luupda.F
git://git.uio.no / u / mrichter / AliRoot.git / blame
? search:
summary | shortlog | log | commit | commitdiff | tree
blob | blame (incremental) | history | HEAD
This commit was generated by cvs2svn to compensate for changes in r2,
[u/mrichter/AliRoot.git] / PYTHIA / jetset / luupda.F
CommitLineData
fe4da5cc 1
2C*********************************************************************
3
4 SUBROUTINE LUUPDA(MUPDA,LFN)
5
6C...Purpose: to facilitate the updating of particle and decay data.
7 COMMON/LUDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200)
8 COMMON/LUDAT2/KCHG(500,3),PMAS(500,4),PARF(2000),VCKM(4,4)
9 COMMON/LUDAT3/MDCY(500,3),MDME(2000,2),BRAT(2000),KFDP(2000,5)
10 COMMON/LUDAT4/CHAF(500)
11 CHARACTER CHAF*8
12 SAVE /LUDAT1/,/LUDAT2/,/LUDAT3/,/LUDAT4/
13 CHARACTER CHINL*80,CHKC*4,CHVAR(19)*9,CHLIN*72,
14 &CHBLK(20)*72,CHOLD*12,CHTMP*12,CHNEW*12,CHCOM*12
15 DATA CHVAR/ 'KCHG(I,1)','KCHG(I,2)','KCHG(I,3)','PMAS(I,1)',
16 &'PMAS(I,2)','PMAS(I,3)','PMAS(I,4)','MDCY(I,1)','MDCY(I,2)',
17 &'MDCY(I,3)','MDME(I,1)','MDME(I,2)','BRAT(I) ','KFDP(I,1)',
18 &'KFDP(I,2)','KFDP(I,3)','KFDP(I,4)','KFDP(I,5)','CHAF(I) '/
19
20C...Write information on file for editing.
21 IF(MSTU(12).GE.1) CALL LULIST(0)
22 IF(MUPDA.EQ.1) THEN
23 DO 110 KC=1,MSTU(6)
24 WRITE(LFN,5000) KC,CHAF(KC),(KCHG(KC,J1),J1=1,3),
25 & (PMAS(KC,J2),J2=1,4),MDCY(KC,1)
26 DO 100 IDC=MDCY(KC,2),MDCY(KC,2)+MDCY(KC,3)-1
27 WRITE(LFN,5100) MDME(IDC,1),MDME(IDC,2),BRAT(IDC),
28 & (KFDP(IDC,J),J=1,5)
29 100 CONTINUE
30 110 CONTINUE
31
32C...Reset variables and read information from edited file.
33 ELSEIF(MUPDA.EQ.2) THEN
34 DO 130 I=1,MSTU(7)
35 MDME(I,1)=1
36 MDME(I,2)=0
37 BRAT(I)=0.
38 DO 120 J=1,5
39 KFDP(I,J)=0
40 120 CONTINUE
41 130 CONTINUE
42 KC=0
43 IDC=0
44 NDC=0
45 140 READ(LFN,5200,END=150) CHINL
46 IF(CHINL(2:5).NE.' ') THEN
47 CHKC=CHINL(2:5)
48 IF(KC.NE.0) THEN
49 MDCY(KC,2)=0
50 IF(NDC.NE.0) MDCY(KC,2)=IDC+1-NDC
51 MDCY(KC,3)=NDC
52 ENDIF
53 READ(CHKC,5300) KC
54 IF(KC.LE.0.OR.KC.GT.MSTU(6)) CALL LUERRM(27,
55 & '(LUUPDA:) Read KC code illegal, KC ='//CHKC)
56 READ(CHINL,5000) KCR,CHAF(KC),(KCHG(KC,J1),J1=1,3),
57 & (PMAS(KC,J2),J2=1,4),MDCY(KC,1)
58 NDC=0
59 ELSE
60 IDC=IDC+1
61 NDC=NDC+1
62 IF(IDC.GE.MSTU(7)) CALL LUERRM(27,
63 & '(LUUPDA:) Decay data arrays full by KC ='//CHKC)
64 READ(CHINL,5100) MDME(IDC,1),MDME(IDC,2),BRAT(IDC),
65 & (KFDP(IDC,J),J=1,5)
66 ENDIF
67 GOTO 140
68 150 MDCY(KC,2)=0
69 IF(NDC.NE.0) MDCY(KC,2)=IDC+1-NDC
70 MDCY(KC,3)=NDC
71
72C...Perform possible tests that new information is consistent.
73 MSTJ24=MSTJ(24)
74 MSTJ(24)=0
75 DO 180 KC=1,MSTU(6)
76 WRITE(CHKC,5300) KC
77 IF(MIN(PMAS(KC,1),PMAS(KC,2),PMAS(KC,3),PMAS(KC,1)-PMAS(KC,3),
78 & PMAS(KC,4)).LT.0..OR.MDCY(KC,3).LT.0) CALL LUERRM(17,
79 & '(LUUPDA:) Mass/width/life/(# channels) wrong for KC ='//CHKC)
80 BRSUM=0.
81 DO 170 IDC=MDCY(KC,2),MDCY(KC,2)+MDCY(KC,3)-1
82 IF(MDME(IDC,2).GT.80) GOTO 170
83 KQ=KCHG(KC,1)
84 PMS=PMAS(KC,1)-PMAS(KC,3)-PARJ(64)
85 MERR=0
86 DO 160 J=1,5
87 KP=KFDP(IDC,J)
88 IF(KP.EQ.0.OR.KP.EQ.81.OR.IABS(KP).EQ.82) THEN
89 ELSEIF(LUCOMP(KP).EQ.0) THEN
90 MERR=3
91 ELSE
92 KQ=KQ-LUCHGE(KP)
93 PMS=PMS-ULMASS(KP)
94 ENDIF
95 160 CONTINUE
96 IF(KQ.NE.0) MERR=MAX(2,MERR)
97 IF(KFDP(IDC,2).NE.0.AND.(KC.LE.20.OR.KC.GT.40).AND.
98 & (KC.LE.80.OR.KC.GT.100).AND.MDME(IDC,2).NE.34.AND.
99 & MDME(IDC,2).NE.61.AND.PMS.LT.0.) MERR=MAX(1,MERR)
100 IF(MERR.EQ.3) CALL LUERRM(17,
101 & '(LUUPDA:) Unknown particle code in decay of KC ='//CHKC)
102 IF(MERR.EQ.2) CALL LUERRM(17,
103 & '(LUUPDA:) Charge not conserved in decay of KC ='//CHKC)
104 IF(MERR.EQ.1) CALL LUERRM(7,
105 & '(LUUPDA:) Kinematically unallowed decay of KC ='//CHKC)
106 BRSUM=BRSUM+BRAT(IDC)
107 170 CONTINUE
108 WRITE(CHTMP,5500) BRSUM
109 IF(ABS(BRSUM).GT.0.0005.AND.ABS(BRSUM-1.).GT.0.0005) CALL
110 & LUERRM(7,'(LUUPDA:) Sum of branching ratios is '//CHTMP(5:12)//
111 & ' for KC ='//CHKC)
112 180 CONTINUE
113 MSTJ(24)=MSTJ24
114
115C...Initialize writing of DATA statements for inclusion in program.
116 ELSEIF(MUPDA.EQ.3) THEN
117 DO 250 IVAR=1,19
118 NDIM=MSTU(6)
119 IF(IVAR.GE.11.AND.IVAR.LE.18) NDIM=MSTU(7)
120 NLIN=1
121 CHLIN=' '
122 CHLIN(7:35)='DATA ('//CHVAR(IVAR)//',I= 1, )/'
123 LLIN=35
124 CHOLD='START'
125
126C...Loop through variables for conversion to characters.
127 DO 230 IDIM=1,NDIM
128 IF(IVAR.EQ.1) WRITE(CHTMP,5400) KCHG(IDIM,1)
129 IF(IVAR.EQ.2) WRITE(CHTMP,5400) KCHG(IDIM,2)
130 IF(IVAR.EQ.3) WRITE(CHTMP,5400) KCHG(IDIM,3)
131 IF(IVAR.EQ.4) WRITE(CHTMP,5500) PMAS(IDIM,1)
132 IF(IVAR.EQ.5) WRITE(CHTMP,5500) PMAS(IDIM,2)
133 IF(IVAR.EQ.6) WRITE(CHTMP,5500) PMAS(IDIM,3)
134 IF(IVAR.EQ.7) WRITE(CHTMP,5500) PMAS(IDIM,4)
135 IF(IVAR.EQ.8) WRITE(CHTMP,5400) MDCY(IDIM,1)
136 IF(IVAR.EQ.9) WRITE(CHTMP,5400) MDCY(IDIM,2)
137 IF(IVAR.EQ.10) WRITE(CHTMP,5400) MDCY(IDIM,3)
138 IF(IVAR.EQ.11) WRITE(CHTMP,5400) MDME(IDIM,1)
139 IF(IVAR.EQ.12) WRITE(CHTMP,5400) MDME(IDIM,2)
140 IF(IVAR.EQ.13) WRITE(CHTMP,5500) BRAT(IDIM)
141 IF(IVAR.EQ.14) WRITE(CHTMP,5400) KFDP(IDIM,1)
142 IF(IVAR.EQ.15) WRITE(CHTMP,5400) KFDP(IDIM,2)
143 IF(IVAR.EQ.16) WRITE(CHTMP,5400) KFDP(IDIM,3)
144 IF(IVAR.EQ.17) WRITE(CHTMP,5400) KFDP(IDIM,4)
145 IF(IVAR.EQ.18) WRITE(CHTMP,5400) KFDP(IDIM,5)
146 IF(IVAR.EQ.19) CHTMP=CHAF(IDIM)
147
148C...Length of variable, trailing decimal zeros, quotation marks.
149 LLOW=1
150 LHIG=1
151 DO 190 LL=1,12
152 IF(CHTMP(13-LL:13-LL).NE.' ') LLOW=13-LL
153 IF(CHTMP(LL:LL).NE.' ') LHIG=LL
154 190 CONTINUE
155 CHNEW=CHTMP(LLOW:LHIG)//' '
156 LNEW=1+LHIG-LLOW
157 IF((IVAR.GE.4.AND.IVAR.LE.7).OR.IVAR.EQ.13) THEN
158 LNEW=LNEW+1
159 200 LNEW=LNEW-1
160 IF(CHNEW(LNEW:LNEW).EQ.'0') GOTO 200
161 IF(LNEW.EQ.1) CHNEW(1:2)='0.'
162 IF(LNEW.EQ.1) LNEW=2
163 ELSEIF(IVAR.EQ.19) THEN
164 DO 210 LL=LNEW,1,-1
165 IF(CHNEW(LL:LL).EQ.'''') THEN
166 CHTMP=CHNEW
167 CHNEW=CHTMP(1:LL)//''''//CHTMP(LL+1:11)
168 LNEW=LNEW+1
169 ENDIF
170 210 CONTINUE
171 CHTMP=CHNEW
172 CHNEW(1:LNEW+2)=''''//CHTMP(1:LNEW)//''''
173 LNEW=LNEW+2
174 ENDIF
175
176C...Form composite character string, often including repetition counter.
177 IF(CHNEW.NE.CHOLD) THEN
178 NRPT=1
179 CHOLD=CHNEW
180 CHCOM=CHNEW
181 LCOM=LNEW
182 ELSE
183 LRPT=LNEW+1
184 IF(NRPT.GE.2) LRPT=LNEW+3
185 IF(NRPT.GE.10) LRPT=LNEW+4
186 IF(NRPT.GE.100) LRPT=LNEW+5
187 IF(NRPT.GE.1000) LRPT=LNEW+6
188 LLIN=LLIN-LRPT
189 NRPT=NRPT+1
190 WRITE(CHTMP,5400) NRPT
191 LRPT=1
192 IF(NRPT.GE.10) LRPT=2
193 IF(NRPT.GE.100) LRPT=3
194 IF(NRPT.GE.1000) LRPT=4
195 CHCOM(1:LRPT+1+LNEW)=CHTMP(13-LRPT:12)//'*'//CHNEW(1:LNEW)
196 LCOM=LRPT+1+LNEW
197 ENDIF
198
199C...Add characters to end of line, to new line (after storing old line),
200C...or to new block of lines (after writing old block).
201 IF(LLIN+LCOM.LE.70) THEN
202 CHLIN(LLIN+1:LLIN+LCOM+1)=CHCOM(1:LCOM)//','
203 LLIN=LLIN+LCOM+1
204 ELSEIF(NLIN.LE.19) THEN
205 CHLIN(LLIN+1:72)=' '
206 CHBLK(NLIN)=CHLIN
207 NLIN=NLIN+1
208 CHLIN(6:6+LCOM+1)='&'//CHCOM(1:LCOM)//','
209 LLIN=6+LCOM+1
210 ELSE
211 CHLIN(LLIN:72)='/'//' '
212 CHBLK(NLIN)=CHLIN
213 WRITE(CHTMP,5400) IDIM-NRPT
214 CHBLK(1)(30:33)=CHTMP(9:12)
215 DO 220 ILIN=1,NLIN
216 WRITE(LFN,5600) CHBLK(ILIN)
217 220 CONTINUE
218 NLIN=1
219 CHLIN=' '
220 CHLIN(7:35+LCOM+1)='DATA ('//CHVAR(IVAR)//',I= , )/'//
221 & CHCOM(1:LCOM)//','
222 WRITE(CHTMP,5400) IDIM-NRPT+1
223 CHLIN(25:28)=CHTMP(9:12)
224 LLIN=35+LCOM+1
225 ENDIF
226 230 CONTINUE
227
228C...Write final block of lines.
229 CHLIN(LLIN:72)='/'//' '
230 CHBLK(NLIN)=CHLIN
231 WRITE(CHTMP,5400) NDIM
232 CHBLK(1)(30:33)=CHTMP(9:12)
233 DO 240 ILIN=1,NLIN
234 WRITE(LFN,5600) CHBLK(ILIN)
235 240 CONTINUE
236 250 CONTINUE
237 ENDIF
238
239C...Formats for reading and writing particle data.
240 5000 FORMAT(1X,I4,2X,A8,3I3,3F12.5,2X,F12.5,I3)
241 5100 FORMAT(5X,2I5,F12.5,5I8)
242 5200 FORMAT(A80)
243 5300 FORMAT(I4)
244 5400 FORMAT(I12)
245 5500 FORMAT(F12.5)
246 5600 FORMAT(A72)
247
248 RETURN
249 END