Analysis Software
Documentation for sPHENIX simulation software
 All Classes Namespaces Files Functions Variables Typedefs Enumerations Enumerator Friends Macros Groups Pages
lugive.f
Go to the documentation of this file. Or view the newest version in sPHENIX GitHub for file lugive.f
1 
2 C*********************************************************************
3 
4  SUBROUTINE lugive(CHIN)
5 
6 C...Purpose: to set values of commonblock variables.
7  common/lujets/n,k(9000,5),p(9000,5),v(9000,5)
8  SAVE /lujets/
9  common/ludat1/mstu(200),paru(200),mstj(200),parj(200)
10  SAVE /ludat1/
11  common/ludat2/kchg(500,3),pmas(500,4),parf(2000),vckm(4,4)
12  SAVE /ludat2/
13  common/ludat3/mdcy(500,3),mdme(2000,2),brat(2000),kfdp(2000,5)
14  SAVE /ludat3/
15  common/ludat4/chaf(500)
16  CHARACTER chaf*8
17  SAVE /ludat4/
18  CHARACTER chin*(*),chfix*104,chbit*104,chold*8,chnew*8,
19  &chnam*4,chvar(17)*4,chalp(2)*26,chind*8,chini*10,chinr*16
20  DATA chvar/'N','K','P','V','MSTU','PARU','MSTJ','PARJ','KCHG',
21  &'PMAS','PARF','VCKM','MDCY','MDME','BRAT','KFDP','CHAF'/
22  DATA chalp/'abcdefghijklmnopqrstuvwxyz',
23  &'ABCDEFGHIJKLMNOPQRSTUVWXYZ'/
24 
25 C...Length of character variable. Subdivide it into instructions.
26  IF(mstu(12).GE.1) CALL lulist(0)
27  chbit=chin//' '
28  lbit=101
29  100 lbit=lbit-1
30  IF(chbit(lbit:lbit).EQ.' ') goto 100
31  ltot=0
32  DO 110 lcom=1,lbit
33  IF(chbit(lcom:lcom).EQ.' ') goto 110
34  ltot=ltot+1
35  chfix(ltot:ltot)=chbit(lcom:lcom)
36  110 CONTINUE
37  llow=0
38  120 lhig=llow+1
39  130 lhig=lhig+1
40  IF(lhig.LE.ltot.AND.chfix(lhig:lhig).NE.';') goto 130
41  lbit=lhig-llow-1
42  chbit(1:lbit)=chfix(llow+1:lhig-1)
43 
44 C...Identify commonblock variable.
45  lnam=1
46  140 lnam=lnam+1
47  IF(chbit(lnam:lnam).NE.'('.AND.chbit(lnam:lnam).NE.'='.AND.
48  &lnam.LE.4) goto 140
49  chnam=chbit(1:lnam-1)//' '
50  DO 150 lcom=1,lnam-1
51  DO 150 lalp=1,26
52  150 IF(chnam(lcom:lcom).EQ.chalp(1)(lalp:lalp)) chnam(lcom:lcom)=
53  &chalp(2)(lalp:lalp)
54  ivar=0
55  DO 160 iv=1,17
56  160 IF(chnam.EQ.chvar(iv)) ivar=iv
57  IF(ivar.EQ.0) THEN
58  CALL luerrm(18,'(LUGIVE:) do not recognize variable '//chnam)
59  llow=lhig
60  IF(llow.LT.ltot) goto 120
61  RETURN
62  ENDIF
63 
64 C...Identify any indices.
65  i=0
66  j=0
67  IF(chbit(lnam:lnam).EQ.'(') THEN
68  lind=lnam
69  170 lind=lind+1
70  IF(chbit(lind:lind).NE.')'.AND.chbit(lind:lind).NE.',') goto 170
71  chind=' '
72  IF((chbit(lnam+1:lnam+1).EQ.'C'.OR.chbit(lnam+1:lnam+1).EQ.'c').
73  & and.(ivar.EQ.9.OR.ivar.EQ.10.OR.ivar.EQ.13.OR.ivar.EQ.17)) THEN
74  chind(lnam-lind+11:8)=chbit(lnam+2:lind-1)
75  READ(chind,'(I8)') i1
76  i=lucomp(i1)
77  ELSE
78  chind(lnam-lind+10:8)=chbit(lnam+1:lind-1)
79  READ(chind,'(I8)') i
80  ENDIF
81  lnam=lind
82  IF(chbit(lnam:lnam).EQ.')') lnam=lnam+1
83  ENDIF
84  IF(chbit(lnam:lnam).EQ.',') THEN
85  lind=lnam
86  180 lind=lind+1
87  IF(chbit(lind:lind).NE.')'.AND.chbit(lind:lind).NE.',') goto 180
88  chind=' '
89  chind(lnam-lind+10:8)=chbit(lnam+1:lind-1)
90  READ(chind,'(I8)') j
91  lnam=lind+1
92  ENDIF
93 
94 C...Check that indices allowed and save old value.
95  ierr=1
96  IF(chbit(lnam:lnam).NE.'=') goto 190
97  IF(ivar.EQ.1) THEN
98  IF(i.NE.0.OR.j.NE.0) goto 190
99  iold=n
100  ELSEIF(ivar.EQ.2) THEN
101  IF(i.LT.1.OR.i.GT.mstu(4).OR.j.LT.1.OR.j.GT.5) goto 190
102  iold=k(i,j)
103  ELSEIF(ivar.EQ.3) THEN
104  IF(i.LT.1.OR.i.GT.mstu(4).OR.j.LT.1.OR.j.GT.5) goto 190
105  rold=p(i,j)
106  ELSEIF(ivar.EQ.4) THEN
107  IF(i.LT.1.OR.i.GT.mstu(4).OR.j.LT.1.OR.j.GT.5) goto 190
108  rold=v(i,j)
109  ELSEIF(ivar.EQ.5) THEN
110  IF(i.LT.1.OR.i.GT.200.OR.j.NE.0) goto 190
111  iold=mstu(i)
112  ELSEIF(ivar.EQ.6) THEN
113  IF(i.LT.1.OR.i.GT.200.OR.j.NE.0) goto 190
114  rold=paru(i)
115  ELSEIF(ivar.EQ.7) THEN
116  IF(i.LT.1.OR.i.GT.200.OR.j.NE.0) goto 190
117  iold=mstj(i)
118  ELSEIF(ivar.EQ.8) THEN
119  IF(i.LT.1.OR.i.GT.200.OR.j.NE.0) goto 190
120  rold=parj(i)
121  ELSEIF(ivar.EQ.9) THEN
122  IF(i.LT.1.OR.i.GT.mstu(6).OR.j.LT.1.OR.j.GT.3) goto 190
123  iold=kchg(i,j)
124  ELSEIF(ivar.EQ.10) THEN
125  IF(i.LT.1.OR.i.GT.mstu(6).OR.j.LT.1.OR.j.GT.4) goto 190
126  rold=pmas(i,j)
127  ELSEIF(ivar.EQ.11) THEN
128  IF(i.LT.1.OR.i.GT.2000.OR.j.NE.0) goto 190
129  rold=parf(i)
130  ELSEIF(ivar.EQ.12) THEN
131  IF(i.LT.1.OR.i.GT.4.OR.j.LT.1.OR.j.GT.4) goto 190
132  rold=vckm(i,j)
133  ELSEIF(ivar.EQ.13) THEN
134  IF(i.LT.1.OR.i.GT.mstu(6).OR.j.LT.1.OR.j.GT.3) goto 190
135  iold=mdcy(i,j)
136  ELSEIF(ivar.EQ.14) THEN
137  IF(i.LT.1.OR.i.GT.mstu(7).OR.j.LT.1.OR.j.GT.2) goto 190
138  iold=mdme(i,j)
139  ELSEIF(ivar.EQ.15) THEN
140  IF(i.LT.1.OR.i.GT.mstu(7).OR.j.NE.0) goto 190
141  rold=brat(i)
142  ELSEIF(ivar.EQ.16) THEN
143  IF(i.LT.1.OR.i.GT.mstu(7).OR.j.LT.1.OR.j.GT.5) goto 190
144  iold=kfdp(i,j)
145  ELSEIF(ivar.EQ.17) THEN
146  IF(i.LT.1.OR.i.GT.mstu(6).OR.j.NE.0) goto 190
147  chold=chaf(i)
148  ENDIF
149  ierr=0
150  190 IF(ierr.EQ.1) THEN
151  CALL luerrm(18,'(LUGIVE:) unallowed indices for '//
152  & chbit(1:lnam-1))
153  llow=lhig
154  IF(llow.LT.ltot) goto 120
155  RETURN
156  ENDIF
157 
158 C...Print current value of variable. Loop back.
159  IF(lnam.GE.lbit) THEN
160  chbit(lnam:14)=' '
161  chbit(15:60)=' has the value '
162  IF(ivar.EQ.1.OR.ivar.EQ.2.OR.ivar.EQ.5.OR.ivar.EQ.7.OR.
163  & ivar.EQ.9.OR.ivar.EQ.13.OR.ivar.EQ.14.OR.ivar.EQ.16) THEN
164  WRITE(chbit(51:60),'(I10)') iold
165  ELSEIF(ivar.NE.17) THEN
166  WRITE(chbit(47:60),'(F14.5)') rold
167  ELSE
168  chbit(53:60)=chold
169  ENDIF
170  IF(mstu(13).GE.1) WRITE(mstu(11),1000) chbit(1:60)
171  llow=lhig
172  IF(llow.LT.ltot) goto 120
173  RETURN
174  ENDIF
175 
176 C...Read in new variable value.
177  IF(ivar.EQ.1.OR.ivar.EQ.2.OR.ivar.EQ.5.OR.ivar.EQ.7.OR.
178  &ivar.EQ.9.OR.ivar.EQ.13.OR.ivar.EQ.14.OR.ivar.EQ.16) THEN
179  chini=' '
180  chini(lnam-lbit+11:10)=chbit(lnam+1:lbit)
181  READ(chini,'(I10)') inew
182  ELSEIF(ivar.NE.17) THEN
183  chinr=' '
184  chinr(lnam-lbit+17:16)=chbit(lnam+1:lbit)
185  READ(chinr,'(F16.2)') rnew
186  ELSE
187  chnew=chbit(lnam+1:lbit)//' '
188  ENDIF
189 
190 C...Store new variable value.
191  IF(ivar.EQ.1) THEN
192  n=inew
193  ELSEIF(ivar.EQ.2) THEN
194  k(i,j)=inew
195  ELSEIF(ivar.EQ.3) THEN
196  p(i,j)=rnew
197  ELSEIF(ivar.EQ.4) THEN
198  v(i,j)=rnew
199  ELSEIF(ivar.EQ.5) THEN
200  mstu(i)=inew
201  ELSEIF(ivar.EQ.6) THEN
202  paru(i)=rnew
203  ELSEIF(ivar.EQ.7) THEN
204  mstj(i)=inew
205  ELSEIF(ivar.EQ.8) THEN
206  parj(i)=rnew
207  ELSEIF(ivar.EQ.9) THEN
208  kchg(i,j)=inew
209  ELSEIF(ivar.EQ.10) THEN
210  pmas(i,j)=rnew
211  ELSEIF(ivar.EQ.11) THEN
212  parf(i)=rnew
213  ELSEIF(ivar.EQ.12) THEN
214  vckm(i,j)=rnew
215  ELSEIF(ivar.EQ.13) THEN
216  mdcy(i,j)=inew
217  ELSEIF(ivar.EQ.14) THEN
218  mdme(i,j)=inew
219  ELSEIF(ivar.EQ.15) THEN
220  brat(i)=rnew
221  ELSEIF(ivar.EQ.16) THEN
222  kfdp(i,j)=inew
223  ELSEIF(ivar.EQ.17) THEN
224  chaf(i)=chnew
225  ENDIF
226 
227 C...Write old and new value. Loop back.
228  chbit(lnam:14)=' '
229  chbit(15:60)=' changed from to '
230  IF(ivar.EQ.1.OR.ivar.EQ.2.OR.ivar.EQ.5.OR.ivar.EQ.7.OR.
231  &ivar.EQ.9.OR.ivar.EQ.13.OR.ivar.EQ.14.OR.ivar.EQ.16) THEN
232  WRITE(chbit(33:42),'(I10)') iold
233  WRITE(chbit(51:60),'(I10)') inew
234  ELSEIF(ivar.NE.17) THEN
235  WRITE(chbit(29:42),'(F14.5)') rold
236  WRITE(chbit(47:60),'(F14.5)') rnew
237  ELSE
238  chbit(35:42)=chold
239  chbit(53:60)=chnew
240  ENDIF
241  IF(mstu(13).GE.1) WRITE(mstu(11),1000) chbit(1:60)
242  llow=lhig
243  IF(llow.LT.ltot) goto 120
244 
245 C...Format statement for output on unit MSTU(11) (by default 6).
246  1000 FORMAT(5x,a60)
247 
248  RETURN
249  END