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