]> git.uio.no Git - u/mrichter/AliRoot.git/blame - PHOS/shaker/lugive.f
git://git.uio.no / u / mrichter / AliRoot.git / blame
? search:
summary | shortlog | log | commit | commitdiff | tree
blob | blame (incremental) | history | HEAD
Defaults updated
[u/mrichter/AliRoot.git] / PHOS / shaker / lugive.f
CommitLineData
fe4da5cc 1*CMZ : 17/07/98 16.45.04 by Federico Carminati
2*-- Author :
3C*********************************************************************
4
5 SUBROUTINE LUGIVE(CHIN)
6
7C...Purpose: to set values of commonblock variables (also in PYTHIA!).
8*KEEP,LUJETS.
9 COMMON /LUJETS/ N,K(200000,5),P(200000,5),V(200000,5)
10 SAVE /LUJETS/
11*KEEP,LUDAT1.
12 COMMON /LUDAT1/ MSTU(200),PARU(200),MSTJ(200),PARJ(200)
13 SAVE /LUDAT1/
14*KEEP,LUDAT2.
15 COMMON /LUDAT2/ KCHG(500,3),PMAS(500,4),PARF(2000),VCKM(4,4)
16 SAVE /LUDAT2/
17*KEEP,LUDAT3.
18 COMMON /LUDAT3/ MDCY(500,3),MDME(2000,2),BRAT(2000),KFDP(2000,5)
19 SAVE /LUDAT3/
20*KEEP,LUDAT4.
21 COMMON /LUDAT4/ CHAF(500)
22 SAVE /LUDAT4/
23*KEND.
24 CHARACTER CHAF*8
25*KEEP,LUDATR.
26 COMMON /LUDATR/ MRLU(6),RRLU(100)
27 SAVE /LUDATR/
28*KEEP,PYSUBS.
29 COMMON /PYSUBS/ MSEL,MSUB(200),KFIN(2,-40:40),CKIN(200)
30 SAVE /PYSUBS/
31*KEEP,PYPARS.
32 COMMON /PYPARS/ MSTP(200),PARP(200),MSTI(200),PARI(200)
33 SAVE /PYPARS/
34*KEEP,PYINT1.
35 COMMON /PYINT1/ MINT(400),VINT(400)
36 SAVE /PYINT1/
37*KEEP,PYINT2.
38 COMMON /PYINT2/ ISET(200),KFPR(200,2),COEF(200,20),ICOL(40,4,2)
39 SAVE /PYINT2/
40*KEEP,PYINT3.
41 COMMON /PYINT3/ XSFX(2,-40:40),ISIG(1000,3),SIGH(1000)
42 SAVE /PYINT3/
43*KEEP,PYINT4.
44 COMMON /PYINT4/ WIDP(21:40,0:40),WIDE(21:40,0:40),WIDS(21:40,3)
45 SAVE /PYINT4/
46*KEEP,PYINT5.
47 COMMON /PYINT5/ NGEN(0:200,3),XSEC(0:200,3)
48 SAVE /PYINT5/
49*KEEP,PYINT6.
50 COMMON /PYINT6/ PROC(0:200)
51 SAVE /PYINT6/
52*KEND.
53 CHARACTER PROC*28
54 CHARACTER CHIN*(*),CHFIX*104,CHBIT*104,CHOLD*8,CHNEW*8,CHOLD2*28,
55 &CHNEW2*28,CHNAM*4,CHVAR(42)*4,CHALP(2)*26,CHIND*8,CHINI*10,
56 &CHINR*16
57 DIMENSION MSVAR(42,8)
58
59C...For each variable to be translated give: name,
60C...integer/real/character, no. of indices, lower&upper index bounds.
61 DATA CHVAR/'N','K','P','V','MSTU','PARU','MSTJ','PARJ','KCHG',
62 &'PMAS','PARF','VCKM','MDCY','MDME','BRAT','KFDP','CHAF','MRLU',
63 &'RRLU','MSEL','MSUB','KFIN','CKIN','MSTP','PARP','MSTI','PARI',
64 &'MINT','VINT','ISET','KFPR','COEF','ICOL','XSFX','ISIG','SIGH',
65 &'WIDP','WIDE','WIDS','NGEN','XSEC','PROC'/
66 DATA ((MSVAR(I,J),J=1,8),I=1,42)/ 1,7*0, 1,2,1,4000,1,5,2*0,
67 & 2,2,1,4000,1,5,2*0, 2,2,1,4000,1,5,2*0, 1,1,1,200,4*0,
68 & 2,1,1,200,4*0, 1,1,1,200,4*0, 2,1,1,200,4*0,
69 & 1,2,1,500,1,3,2*0, 2,2,1,500,1,4,2*0, 2,1,1,2000,4*0,
70 & 2,2,1,4,1,4,2*0, 1,2,1,500,1,3,2*0, 1,2,1,2000,1,2,2*0,
71 & 2,1,1,2000,4*0, 1,2,1,2000,1,5,2*0, 3,1,1,500,4*0,
72 & 1,1,1,6,4*0, 2,1,1,100,4*0,
73 & 1,7*0, 1,1,1,200,4*0, 1,2,1,2,-40,40,2*0, 2,1,1,200,4*0,
74 & 1,1,1,200,4*0, 2,1,1,200,4*0, 1,1,1,200,4*0, 2,1,1,200,4*0,
75 & 1,1,1,400,4*0, 2,1,1,400,4*0, 1,1,1,200,4*0,
76 & 1,2,1,200,1,2,2*0, 2,2,1,200,1,20,2*0, 1,3,1,40,1,4,1,2,
77 & 2,2,1,2,-40,40,2*0, 1,2,1,1000,1,3,2*0, 2,1,1,1000,4*0,
78 & 2,2,21,40,0,40,2*0, 2,2,21,40,0,40,2*0, 2,2,21,40,1,3,2*0,
79 & 1,2,0,200,1,3,2*0, 2,2,0,200,1,3,2*0, 4,1,0,200,4*0/
80 DATA CHALP/'abcdefghijklmnopqrstuvwxyz',
81 &'ABCDEFGHIJKLMNOPQRSTUVWXYZ'/
82
83C...Length of character variable. Subdivide it into instructions.
84 IF(MSTU(12).GE.1) CALL LULIST(0)
85 CHBIT=CHIN//' '
86 LBIT=101
87 100 LBIT=LBIT-1
88 IF(CHBIT(LBIT:LBIT).EQ.' ') GOTO 100
89 LTOT=0
90 DO 110 LCOM=1,LBIT
91 IF(CHBIT(LCOM:LCOM).EQ.' ') GOTO 110
92 LTOT=LTOT+1
93 CHFIX(LTOT:LTOT)=CHBIT(LCOM:LCOM)
94 110 CONTINUE
95 LLOW=0
96 120 LHIG=LLOW+1
97 130 LHIG=LHIG+1
98 IF(LHIG.LE.LTOT.AND.CHFIX(LHIG:LHIG).NE.';') GOTO 130
99 LBIT=LHIG-LLOW-1
100 CHBIT(1:LBIT)=CHFIX(LLOW+1:LHIG-1)
101
102C...Identify commonblock variable.
103 LNAM=1
104 140 LNAM=LNAM+1
105 IF(CHBIT(LNAM:LNAM).NE.'('.AND.CHBIT(LNAM:LNAM).NE.'='.AND.
106 &LNAM.LE.4) GOTO 140
107 CHNAM=CHBIT(1:LNAM-1)//' '
108 DO 150 LCOM=1,LNAM-1
109 DO 150 LALP=1,26
110 150 IF(CHNAM(LCOM:LCOM).EQ.CHALP(1)(LALP:LALP)) CHNAM(LCOM:LCOM)=
111 &CHALP(2)(LALP:LALP)
112 IVAR=0
113 DO 160 IV=1,42
114 160 IF(CHNAM.EQ.CHVAR(IV)) IVAR=IV
115 IF(IVAR.EQ.0) THEN
116 CALL LUERRM(18,'(LUGIVE:) do not recognize variable '//CHNAM)
117 LLOW=LHIG
118 IF(LLOW.LT.LTOT) GOTO 120
119 RETURN
120 ENDIF
121
122C...Identify any indices.
123 I1=0
124 I2=0
125 I3=0
126 NINDX=0
127 IF(CHBIT(LNAM:LNAM).EQ.'(') THEN
128 LIND=LNAM
129 170 LIND=LIND+1
130 IF(CHBIT(LIND:LIND).NE.')'.AND.CHBIT(LIND:LIND).NE.',') GOTO 170
131 CHIND=' '
132 IF((CHBIT(LNAM+1:LNAM+1).EQ.'C'.OR.CHBIT(LNAM+1:LNAM+1).EQ.'c').
133 & AND.(IVAR.EQ.9.OR.IVAR.EQ.10.OR.IVAR.EQ.13.OR.IVAR.EQ.17)) THEN
134 CHIND(LNAM-LIND+11:8)=CHBIT(LNAM+2:LIND-1)
135 READ(CHIND,'(I8)') KF
136 I1=LUCOMP(KF)
137 ELSEIF(CHBIT(LNAM+1:LNAM+1).EQ.'C'.OR.CHBIT(LNAM+1:LNAM+1).EQ.
138 & 'c') THEN
139 CALL LUERRM(18,'(LUGIVE:) not allowed to use C index for '//
140 & CHNAM)
141 LLOW=LHIG
142 IF(LLOW.LT.LTOT) GOTO 120
143 RETURN
144 ELSE
145 CHIND(LNAM-LIND+10:8)=CHBIT(LNAM+1:LIND-1)
146 READ(CHIND,'(I8)') I1
147 ENDIF
148 LNAM=LIND
149 IF(CHBIT(LNAM:LNAM).EQ.')') LNAM=LNAM+1
150 NINDX=1
151 ENDIF
152 IF(CHBIT(LNAM:LNAM).EQ.',') THEN
153 LIND=LNAM
154 180 LIND=LIND+1
155 IF(CHBIT(LIND:LIND).NE.')'.AND.CHBIT(LIND:LIND).NE.',') GOTO 180
156 CHIND=' '
157 CHIND(LNAM-LIND+10:8)=CHBIT(LNAM+1:LIND-1)
158 READ(CHIND,'(I8)') I2
159 LNAM=LIND
160 IF(CHBIT(LNAM:LNAM).EQ.')') LNAM=LNAM+1
161 NINDX=2
162 ENDIF
163 IF(CHBIT(LNAM:LNAM).EQ.',') THEN
164 LIND=LNAM
165 190 LIND=LIND+1
166 IF(CHBIT(LIND:LIND).NE.')'.AND.CHBIT(LIND:LIND).NE.',') GOTO 190
167 CHIND=' '
168 CHIND(LNAM-LIND+10:8)=CHBIT(LNAM+1:LIND-1)
169 READ(CHIND,'(I8)') I3
170 LNAM=LIND+1
171 NINDX=3
172 ENDIF
173
174C...Check that indices allowed.
175 IERR=0
176 IF(NINDX.NE.MSVAR(IVAR,2)) IERR=1
177 IF(NINDX.GE.1.AND.(I1.LT.MSVAR(IVAR,3).OR.I1.GT.MSVAR(IVAR,4)))
178 &IERR=2
179 IF(NINDX.GE.2.AND.(I2.LT.MSVAR(IVAR,5).OR.I2.GT.MSVAR(IVAR,6)))
180 &IERR=3
181 IF(NINDX.EQ.3.AND.(I3.LT.MSVAR(IVAR,7).OR.I3.GT.MSVAR(IVAR,8)))
182 &IERR=4
183 IF(CHBIT(LNAM:LNAM).NE.'=') IERR=5
184 IF(IERR.GE.1) THEN
185 CALL LUERRM(18,'(LUGIVE:) unallowed indices for '//
186 & CHBIT(1:LNAM-1))
187 LLOW=LHIG
188 IF(LLOW.LT.LTOT) GOTO 120
189 RETURN
190 ENDIF
191
192C...Save old value of variable.
193 IF(IVAR.EQ.1) THEN
194 IOLD=N
195 ELSEIF(IVAR.EQ.2) THEN
196 IOLD=K(I1,I2)
197 ELSEIF(IVAR.EQ.3) THEN
198 ROLD=P(I1,I2)
199 ELSEIF(IVAR.EQ.4) THEN
200 ROLD=V(I1,I2)
201 ELSEIF(IVAR.EQ.5) THEN
202 IOLD=MSTU(I1)
203 ELSEIF(IVAR.EQ.6) THEN
204 ROLD=PARU(I1)
205 ELSEIF(IVAR.EQ.7) THEN
206 IOLD=MSTJ(I1)
207 ELSEIF(IVAR.EQ.8) THEN
208 ROLD=PARJ(I1)
209 ELSEIF(IVAR.EQ.9) THEN
210 IOLD=KCHG(I1,I2)
211 ELSEIF(IVAR.EQ.10) THEN
212 ROLD=PMAS(I1,I2)
213 ELSEIF(IVAR.EQ.11) THEN
214 ROLD=PARF(I1)
215 ELSEIF(IVAR.EQ.12) THEN
216 ROLD=VCKM(I1,I2)
217 ELSEIF(IVAR.EQ.13) THEN
218 IOLD=MDCY(I1,I2)
219 ELSEIF(IVAR.EQ.14) THEN
220 IOLD=MDME(I1,I2)
221 ELSEIF(IVAR.EQ.15) THEN
222 ROLD=BRAT(I1)
223 ELSEIF(IVAR.EQ.16) THEN
224 IOLD=KFDP(I1,I2)
225 ELSEIF(IVAR.EQ.17) THEN
226 CHOLD=CHAF(I1)
227 ELSEIF(IVAR.EQ.18) THEN
228 IOLD=MRLU(I1)
229 ELSEIF(IVAR.EQ.19) THEN
230 ROLD=RRLU(I1)
231 ELSEIF(IVAR.EQ.20) THEN
232 IOLD=MSEL
233 ELSEIF(IVAR.EQ.21) THEN
234 IOLD=MSUB(I1)
235 ELSEIF(IVAR.EQ.22) THEN
236 IOLD=KFIN(I1,I2)
237 ELSEIF(IVAR.EQ.23) THEN
238 ROLD=CKIN(I1)
239 ELSEIF(IVAR.EQ.24) THEN
240 IOLD=MSTP(I1)
241 ELSEIF(IVAR.EQ.25) THEN
242 ROLD=PARP(I1)
243 ELSEIF(IVAR.EQ.26) THEN
244 IOLD=MSTI(I1)
245 ELSEIF(IVAR.EQ.27) THEN
246 ROLD=PARI(I1)
247 ELSEIF(IVAR.EQ.28) THEN
248 IOLD=MINT(I1)
249 ELSEIF(IVAR.EQ.29) THEN
250 ROLD=VINT(I1)
251 ELSEIF(IVAR.EQ.30) THEN
252 IOLD=ISET(I1)
253 ELSEIF(IVAR.EQ.31) THEN
254 IOLD=KFPR(I1,I2)
255 ELSEIF(IVAR.EQ.32) THEN
256 ROLD=COEF(I1,I2)
257 ELSEIF(IVAR.EQ.33) THEN
258 IOLD=ICOL(I1,I2,I3)
259 ELSEIF(IVAR.EQ.34) THEN
260 ROLD=XSFX(I1,I2)
261 ELSEIF(IVAR.EQ.35) THEN
262 IOLD=ISIG(I1,I2)
263 ELSEIF(IVAR.EQ.36) THEN
264 ROLD=SIGH(I1)
265 ELSEIF(IVAR.EQ.37) THEN
266 ROLD=WIDP(I1,I2)
267 ELSEIF(IVAR.EQ.38) THEN
268 ROLD=WIDE(I1,I2)
269 ELSEIF(IVAR.EQ.39) THEN
270 ROLD=WIDS(I1,I2)
271 ELSEIF(IVAR.EQ.40) THEN
272 IOLD=NGEN(I1,I2)
273 ELSEIF(IVAR.EQ.41) THEN
274 ROLD=XSEC(I1,I2)
275 ELSEIF(IVAR.EQ.42) THEN
276 CHOLD2=PROC(I1)
277 ENDIF
278
279C...Print current value of variable. Loop back.
280 IF(LNAM.GE.LBIT) THEN
281 CHBIT(LNAM:14)=' '
282 CHBIT(15:60)=' has the value '
283 IF(MSVAR(IVAR,1).EQ.1) THEN
284 WRITE(CHBIT(51:60),'(I10)') IOLD
285 ELSEIF(MSVAR(IVAR,1).EQ.2) THEN
286 WRITE(CHBIT(47:60),'(F14.5)') ROLD
287 ELSEIF(MSVAR(IVAR,1).EQ.3) THEN
288 CHBIT(53:60)=CHOLD
289 ELSE
290 CHBIT(33:60)=CHOLD
291 ENDIF
292 IF(MSTU(13).GE.1) WRITE(MSTU(11),1000) CHBIT(1:60)
293 LLOW=LHIG
294 IF(LLOW.LT.LTOT) GOTO 120
295 RETURN
296 ENDIF
297
298C...Read in new variable value.
299 IF(MSVAR(IVAR,1).EQ.1) THEN
300 CHINI=' '
301 CHINI(LNAM-LBIT+11:10)=CHBIT(LNAM+1:LBIT)
302 READ(CHINI,'(I10)') INEW
303 ELSEIF(MSVAR(IVAR,1).EQ.2) THEN
304 CHINR=' '
305 CHINR(LNAM-LBIT+17:16)=CHBIT(LNAM+1:LBIT)
306 READ(CHINR,'(F16.2)') RNEW
307 ELSEIF(MSVAR(IVAR,1).EQ.3) THEN
308 CHNEW=CHBIT(LNAM+1:LBIT)//' '
309 ELSE
310 CHNEW2=CHBIT(LNAM+1:LBIT)//' '
311 ENDIF
312
313C...Store new variable value.
314 IF(IVAR.EQ.1) THEN
315 N=INEW
316 ELSEIF(IVAR.EQ.2) THEN
317 K(I1,I2)=INEW
318 ELSEIF(IVAR.EQ.3) THEN
319 P(I1,I2)=RNEW
320 ELSEIF(IVAR.EQ.4) THEN
321 V(I1,I2)=RNEW
322 ELSEIF(IVAR.EQ.5) THEN
323 MSTU(I1)=INEW
324 ELSEIF(IVAR.EQ.6) THEN
325 PARU(I1)=RNEW
326 ELSEIF(IVAR.EQ.7) THEN
327 MSTJ(I1)=INEW
328 ELSEIF(IVAR.EQ.8) THEN
329 PARJ(I1)=RNEW
330 ELSEIF(IVAR.EQ.9) THEN
331 KCHG(I1,I2)=INEW
332 ELSEIF(IVAR.EQ.10) THEN
333 PMAS(I1,I2)=RNEW
334 ELSEIF(IVAR.EQ.11) THEN
335 PARF(I1)=RNEW
336 ELSEIF(IVAR.EQ.12) THEN
337 VCKM(I1,I2)=RNEW
338 ELSEIF(IVAR.EQ.13) THEN
339 MDCY(I1,I2)=INEW
340 ELSEIF(IVAR.EQ.14) THEN
341 MDME(I1,I2)=INEW
342 ELSEIF(IVAR.EQ.15) THEN
343 BRAT(I1)=RNEW
344 ELSEIF(IVAR.EQ.16) THEN
345 KFDP(I1,I2)=INEW
346 ELSEIF(IVAR.EQ.17) THEN
347 CHAF(I1)=CHNEW
348 ELSEIF(IVAR.EQ.18) THEN
349 MRLU(I1)=INEW
350 ELSEIF(IVAR.EQ.19) THEN
351 RRLU(I1)=RNEW
352 ELSEIF(IVAR.EQ.20) THEN
353 MSEL=INEW
354 ELSEIF(IVAR.EQ.21) THEN
355 MSUB(I1)=INEW
356 ELSEIF(IVAR.EQ.22) THEN
357 KFIN(I1,I2)=INEW
358 ELSEIF(IVAR.EQ.23) THEN
359 CKIN(I1)=RNEW
360 ELSEIF(IVAR.EQ.24) THEN
361 MSTP(I1)=INEW
362 ELSEIF(IVAR.EQ.25) THEN
363 PARP(I1)=RNEW
364 ELSEIF(IVAR.EQ.26) THEN
365 MSTI(I1)=INEW
366 ELSEIF(IVAR.EQ.27) THEN
367 PARI(I1)=RNEW
368 ELSEIF(IVAR.EQ.28) THEN
369 MINT(I1)=INEW
370 ELSEIF(IVAR.EQ.29) THEN
371 VINT(I1)=RNEW
372 ELSEIF(IVAR.EQ.30) THEN
373 ISET(I1)=INEW
374 ELSEIF(IVAR.EQ.31) THEN
375 KFPR(I1,I2)=INEW
376 ELSEIF(IVAR.EQ.32) THEN
377 COEF(I1,I2)=RNEW
378 ELSEIF(IVAR.EQ.33) THEN
379 ICOL(I1,I2,I3)=INEW
380 ELSEIF(IVAR.EQ.34) THEN
381 XSFX(I1,I2)=RNEW
382 ELSEIF(IVAR.EQ.35) THEN
383 ISIG(I1,I2)=INEW
384 ELSEIF(IVAR.EQ.36) THEN
385 SIGH(I1)=RNEW
386 ELSEIF(IVAR.EQ.37) THEN
387 WIDP(I1,I2)=RNEW
388 ELSEIF(IVAR.EQ.38) THEN
389 WIDE(I1,I2)=RNEW
390 ELSEIF(IVAR.EQ.39) THEN
391 WIDS(I1,I2)=RNEW
392 ELSEIF(IVAR.EQ.40) THEN
393 NGEN(I1,I2)=INEW
394 ELSEIF(IVAR.EQ.41) THEN
395 XSEC(I1,I2)=RNEW
396 ELSEIF(IVAR.EQ.42) THEN
397 PROC(I1)=CHNEW2
398 ENDIF
399
400C...Write old and new value. Loop back.
401 CHBIT(LNAM:14)=' '
402 CHBIT(15:60)=' changed from to '
403 IF(MSVAR(IVAR,1).EQ.1) THEN
404 WRITE(CHBIT(33:42),'(I10)') IOLD
405 WRITE(CHBIT(51:60),'(I10)') INEW
406 IF(MSTU(13).GE.1) WRITE(MSTU(11),1000) CHBIT(1:60)
407 ELSEIF(MSVAR(IVAR,1).EQ.2) THEN
408 WRITE(CHBIT(29:42),'(F14.5)') ROLD
409 WRITE(CHBIT(47:60),'(F14.5)') RNEW
410 IF(MSTU(13).GE.1) WRITE(MSTU(11),1000) CHBIT(1:60)
411 ELSEIF(MSVAR(IVAR,1).EQ.3) THEN
412 CHBIT(35:42)=CHOLD
413 CHBIT(53:60)=CHNEW
414 IF(MSTU(13).GE.1) WRITE(MSTU(11),1000) CHBIT(1:60)
415 ELSE
416 CHBIT(15:88)=' changed from '//CHOLD2//' to '//CHNEW2
417 IF(MSTU(13).GE.1) WRITE(MSTU(11),1100) CHBIT(1:88)
418 ENDIF
419 LLOW=LHIG
420 IF(LLOW.LT.LTOT) GOTO 120
421
422C...Format statement for output on unit MSTU(11) (by default 6).
423 1000 FORMAT(5X,A60)
424 1100 FORMAT(5X,A88)
425
426 RETURN
427 END