]> git.uio.no Git - u/mrichter/AliRoot.git/blame - HIJING/hipyset1_35/luupda_hijing.F
git://git.uio.no / u / mrichter / AliRoot.git / blame
? search:
summary | shortlog | log | commit | commitdiff | tree
blob | blame (incremental) | history | HEAD
Fix for FMD DA
[u/mrichter/AliRoot.git] / HIJING / hipyset1_35 / luupda_hijing.F
CommitLineData
e74335a4 1* $Id$
2
3C*********************************************************************
4
5 SUBROUTINE LUUPDA_HIJING(MUPDA,LFN)
6
7C...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
19C...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
30C...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
68C...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
113C...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
124C...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
146C...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
173C...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
196C...Add characters to end of line, to new line (after storing old line),
197C...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
224C...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
234C...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