Analysis Software
Documentation for sPHENIX simulation software
 All Classes Namespaces Files Functions Variables Typedefs Enumerations Enumerator Friends Macros Groups Pages
pygive.f
Go to the documentation of this file. Or view the newest version in sPHENIX GitHub for file pygive.f
1 
2 C*********************************************************************
3 
4 C...PYGIVE
5 C...Sets values of commonblock variables.
6 
7  SUBROUTINE pygive(CHIN)
8 
9 C...Double precision and integer declarations.
10  IMPLICIT DOUBLE PRECISION(a-h, o-z)
11  IMPLICIT INTEGER(i-n)
12  INTEGER pyk,pychge,pycomp
13 C...Commonblocks.
14  common/pyjets/n,npad,k(4000,5),p(4000,5),v(4000,5)
15  common/pydat1/mstu(200),paru(200),mstj(200),parj(200)
16  common/pydat2/kchg(500,4),pmas(500,4),parf(2000),vckm(4,4)
17  common/pydat3/mdcy(500,3),mdme(8000,2),brat(8000),kfdp(8000,5)
18  common/pydat4/chaf(500,2)
19  CHARACTER chaf*16
20  common/pydatr/mrpy(6),rrpy(100)
21  common/pysubs/msel,mselpd,msub(500),kfin(2,-40:40),ckin(200)
22  common/pypars/mstp(200),parp(200),msti(200),pari(200)
23  common/pyint1/mint(400),vint(400)
24  common/pyint2/iset(500),kfpr(500,2),coef(500,20),icol(40,4,2)
25  common/pyint3/xsfx(2,-40:40),isig(1000,3),sigh(1000)
26  common/pyint4/mwid(500),wids(500,5)
27  common/pyint5/ngenpd,ngen(0:500,3),xsec(0:500,3)
28  common/pyint6/proc(0:500)
29  CHARACTER proc*28
30  common/pyint7/sigt(0:6,0:6,0:5)
31  common/pyint8/xpvmd(-6:6),xpanl(-6:6),xpanh(-6:6),xpbeh(-6:6),
32  &xpdir(-6:6)
33  common/pymssm/imss(0:99),rmss(0:99)
34  common/pymsrv/rvlam(3,3,3), rvlamp(3,3,3), rvlamb(3,3,3)
35  common/pytcsm/itcm(0:99),rtcm(0:99)
36  SAVE /pyjets/,/pydat1/,/pydat2/,/pydat3/,/pydat4/,/pydatr/,
37  &/pysubs/,/pypars/,/pyint1/,/pyint2/,/pyint3/,/pyint4/,
38  &/pyint5/,/pyint6/,/pyint7/,/pyint8/,/pymssm/,/pymsrv/,/pytcsm/
39 C...Local arrays and character variables.
40  CHARACTER chin*(*),chfix*104,chbit*104,chold*8,chnew*8,chold2*28,
41  &chnew2*28,chnam*6,chvar(54)*6,chalp(2)*26,chind*8,chini*10,
42  &chinr*16,chdig*10
43  dimension msvar(54,8)
44 
45 C...For each variable to be translated give: name,
46 C...integer/real/character, no. of indices, lower&upper index bounds.
47  DATA chvar/'N','K','P','V','MSTU','PARU','MSTJ','PARJ','KCHG',
48  &'PMAS','PARF','VCKM','MDCY','MDME','BRAT','KFDP','CHAF','MRPY',
49  &'RRPY','MSEL','MSUB','KFIN','CKIN','MSTP','PARP','MSTI','PARI',
50  &'MINT','VINT','ISET','KFPR','COEF','ICOL','XSFX','ISIG','SIGH',
51  &'MWID','WIDS','NGEN','XSEC','PROC','SIGT','XPVMD','XPANL',
52  &'XPANH','XPBEH','XPDIR','IMSS','RMSS','RVLAM','RVLAMP','RVLAMB',
53  &'ITCM','RTCM'/
54  DATA ((msvar(i,j),j=1,8),i=1,54)/ 1,7*0, 1,2,1,4000,1,5,2*0,
55  &2,2,1,4000,1,5,2*0, 2,2,1,4000,1,5,2*0, 1,1,1,200,4*0,
56  &2,1,1,200,4*0, 1,1,1,200,4*0, 2,1,1,200,4*0,
57  &1,2,1,500,1,4,2*0, 2,2,1,500,1,4,2*0, 2,1,1,2000,4*0,
58  &2,2,1,4,1,4,2*0, 1,2,1,500,1,3,2*0, 1,2,1,8000,1,2,2*0,
59  &2,1,1,8000,4*0, 1,2,1,8000,1,5,2*0, 3,2,1,500,1,2,2*0,
60  &1,1,1,6,4*0, 2,1,1,100,4*0,
61  &1,7*0, 1,1,1,500,4*0, 1,2,1,2,-40,40,2*0, 2,1,1,200,4*0,
62  &1,1,1,200,4*0, 2,1,1,200,4*0, 1,1,1,200,4*0, 2,1,1,200,4*0,
63  &1,1,1,400,4*0, 2,1,1,400,4*0, 1,1,1,500,4*0,
64  &1,2,1,500,1,2,2*0, 2,2,1,500,1,20,2*0, 1,3,1,40,1,4,1,2,
65  &2,2,1,2,-40,40,2*0, 1,2,1,1000,1,3,2*0, 2,1,1,1000,4*0,
66  &1,1,1,500,4*0, 2,2,1,500,1,5,2*0, 1,2,0,500,1,3,2*0,
67  &2,2,0,500,1,3,2*0, 4,1,0,500,4*0, 2,3,0,6,0,6,0,5,
68  &2,1,-6,6,4*0, 2,1,-6,6,4*0, 2,1,-6,6,4*0,
69  &2,1,-6,6,4*0, 2,1,-6,6,4*0, 1,1,0,99,4*0, 2,1,0,99,4*0,
70  &2,3,1,3,1,3,1,3, 2,3,1,3,1,3,1,3, 2,3,1,3,1,3,1,3,
71  &1,1,0,99,4*0, 2,1,0,99,4*0/
72  DATA chalp/'abcdefghijklmnopqrstuvwxyz',
73  &'ABCDEFGHIJKLMNOPQRSTUVWXYZ'/, chdig/'1234567890'/
74 
75 C...Length of character variable. Subdivide it into instructions.
76  IF(mstu(12).NE.12345.AND.chin.NE.'mstu(12)=12345'.AND.
77  &chin.NE.'MSTU(12)=12345') CALL pylist(0)
78  chbit=chin//' '
79  lbit=101
80  100 lbit=lbit-1
81  IF(chbit(lbit:lbit).EQ.' ') goto 100
82  ltot=0
83  DO 110 lcom=1,lbit
84  IF(chbit(lcom:lcom).EQ.' ') goto 110
85  ltot=ltot+1
86  chfix(ltot:ltot)=chbit(lcom:lcom)
87  110 CONTINUE
88  llow=0
89  120 lhig=llow+1
90  130 lhig=lhig+1
91  IF(lhig.LE.ltot.AND.chfix(lhig:lhig).NE.';') goto 130
92  lbit=lhig-llow-1
93  chbit(1:lbit)=chfix(llow+1:lhig-1)
94 
95 C...Send off decay-mode on/off commands to PYONOF.
96  ionof=0
97  DO 135 ldig=1,10
98  IF(chbit(1:1).EQ.chdig(ldig:ldig)) ionof=1
99  135 CONTINUE
100  IF(ionof.EQ.1) THEN
101  CALL pyonof(chin)
102  RETURN
103  ENDIF
104 
105 C...Peel off any text following exclamation mark.
106  lhig2=lbit
107  DO 140 llow2=lhig2,1,-1
108  IF(chbit(llow2:llow2).EQ.'!') lbit=llow2-1
109  140 CONTINUE
110  IF(lbit.EQ.0) RETURN
111 
112 C...Identify commonblock variable.
113  lnam=1
114  150 lnam=lnam+1
115  IF(chbit(lnam:lnam).NE.'('.AND.chbit(lnam:lnam).NE.'='.AND.
116  &lnam.LE.6) goto 150
117  chnam=chbit(1:lnam-1)//' '
118  DO 170 lcom=1,lnam-1
119  DO 160 lalp=1,26
120  IF(chnam(lcom:lcom).EQ.chalp(1)(lalp:lalp)) chnam(lcom:lcom)=
121  & chalp(2)(lalp:lalp)
122  160 CONTINUE
123  170 CONTINUE
124  ivar=0
125  DO 180 iv=1,54
126  IF(chnam.EQ.chvar(iv)) ivar=iv
127  180 CONTINUE
128  IF(ivar.EQ.0) THEN
129  CALL pyerrm(18,'(PYGIVE:) do not recognize variable '//chnam)
130  llow=lhig
131  IF(llow.LT.ltot) goto 120
132  RETURN
133  ENDIF
134 
135 C...Identify any indices.
136  i1=0
137  i2=0
138  i3=0
139  nindx=0
140  IF(chbit(lnam:lnam).EQ.'(') THEN
141  lind=lnam
142  190 lind=lind+1
143  IF(chbit(lind:lind).NE.')'.AND.chbit(lind:lind).NE.',') goto 190
144  chind=' '
145  IF((chbit(lnam+1:lnam+1).EQ.'C'.OR.chbit(lnam+1:lnam+1).EQ.'c')
146  & .AND.(ivar.EQ.9.OR.ivar.EQ.10.OR.ivar.EQ.13.OR.ivar.EQ.17.OR.
147  & ivar.EQ.37)) THEN
148  chind(lnam-lind+11:8)=chbit(lnam+2:lind-1)
149  READ(chind,'(I8)') kf
150  i1=pycomp(kf)
151  ELSEIF(chbit(lnam+1:lnam+1).EQ.'C'.OR.chbit(lnam+1:lnam+1).EQ.
152  & 'c') THEN
153  CALL pyerrm(18,'(PYGIVE:) not allowed to use C index for '//
154  & chnam)
155  llow=lhig
156  IF(llow.LT.ltot) goto 120
157  RETURN
158  ELSE
159  chind(lnam-lind+10:8)=chbit(lnam+1:lind-1)
160  READ(chind,'(I8)') i1
161  ENDIF
162  lnam=lind
163  IF(chbit(lnam:lnam).EQ.')') lnam=lnam+1
164  nindx=1
165  ENDIF
166  IF(chbit(lnam:lnam).EQ.',') THEN
167  lind=lnam
168  200 lind=lind+1
169  IF(chbit(lind:lind).NE.')'.AND.chbit(lind:lind).NE.',') goto 200
170  chind=' '
171  chind(lnam-lind+10:8)=chbit(lnam+1:lind-1)
172  READ(chind,'(I8)') i2
173  lnam=lind
174  IF(chbit(lnam:lnam).EQ.')') lnam=lnam+1
175  nindx=2
176  ENDIF
177  IF(chbit(lnam:lnam).EQ.',') THEN
178  lind=lnam
179  210 lind=lind+1
180  IF(chbit(lind:lind).NE.')'.AND.chbit(lind:lind).NE.',') goto 210
181  chind=' '
182  chind(lnam-lind+10:8)=chbit(lnam+1:lind-1)
183  READ(chind,'(I8)') i3
184  lnam=lind+1
185  nindx=3
186  ENDIF
187 
188 C...Check that indices allowed.
189  ierr=0
190  IF(nindx.NE.msvar(ivar,2)) ierr=1
191  IF(nindx.GE.1.AND.(i1.LT.msvar(ivar,3).OR.i1.GT.msvar(ivar,4)))
192  &ierr=2
193  IF(nindx.GE.2.AND.(i2.LT.msvar(ivar,5).OR.i2.GT.msvar(ivar,6)))
194  &ierr=3
195  IF(nindx.EQ.3.AND.(i3.LT.msvar(ivar,7).OR.i3.GT.msvar(ivar,8)))
196  &ierr=4
197  IF(chbit(lnam:lnam).NE.'=') ierr=5
198  IF(ierr.GE.1) THEN
199  CALL pyerrm(18,'(PYGIVE:) unallowed indices for '//
200  & chbit(1:lnam-1))
201  llow=lhig
202  IF(llow.LT.ltot) goto 120
203  RETURN
204  ENDIF
205 
206 C...Save old value of variable.
207  IF(ivar.EQ.1) THEN
208  iold=n
209  ELSEIF(ivar.EQ.2) THEN
210  iold=k(i1,i2)
211  ELSEIF(ivar.EQ.3) THEN
212  rold=p(i1,i2)
213  ELSEIF(ivar.EQ.4) THEN
214  rold=v(i1,i2)
215  ELSEIF(ivar.EQ.5) THEN
216  iold=mstu(i1)
217  ELSEIF(ivar.EQ.6) THEN
218  rold=paru(i1)
219  ELSEIF(ivar.EQ.7) THEN
220  iold=mstj(i1)
221  ELSEIF(ivar.EQ.8) THEN
222  rold=parj(i1)
223  ELSEIF(ivar.EQ.9) THEN
224  iold=kchg(i1,i2)
225  ELSEIF(ivar.EQ.10) THEN
226  rold=pmas(i1,i2)
227  ELSEIF(ivar.EQ.11) THEN
228  rold=parf(i1)
229  ELSEIF(ivar.EQ.12) THEN
230  rold=vckm(i1,i2)
231  ELSEIF(ivar.EQ.13) THEN
232  iold=mdcy(i1,i2)
233  ELSEIF(ivar.EQ.14) THEN
234  iold=mdme(i1,i2)
235  ELSEIF(ivar.EQ.15) THEN
236  rold=brat(i1)
237  ELSEIF(ivar.EQ.16) THEN
238  iold=kfdp(i1,i2)
239  ELSEIF(ivar.EQ.17) THEN
240  chold=chaf(i1,i2)(1:8)
241  ELSEIF(ivar.EQ.18) THEN
242  iold=mrpy(i1)
243  ELSEIF(ivar.EQ.19) THEN
244  rold=rrpy(i1)
245  ELSEIF(ivar.EQ.20) THEN
246  iold=msel
247  ELSEIF(ivar.EQ.21) THEN
248  iold=msub(i1)
249  ELSEIF(ivar.EQ.22) THEN
250  iold=kfin(i1,i2)
251  ELSEIF(ivar.EQ.23) THEN
252  rold=ckin(i1)
253  ELSEIF(ivar.EQ.24) THEN
254  iold=mstp(i1)
255  ELSEIF(ivar.EQ.25) THEN
256  rold=parp(i1)
257  ELSEIF(ivar.EQ.26) THEN
258  iold=msti(i1)
259  ELSEIF(ivar.EQ.27) THEN
260  rold=pari(i1)
261  ELSEIF(ivar.EQ.28) THEN
262  iold=mint(i1)
263  ELSEIF(ivar.EQ.29) THEN
264  rold=vint(i1)
265  ELSEIF(ivar.EQ.30) THEN
266  iold=iset(i1)
267  ELSEIF(ivar.EQ.31) THEN
268  iold=kfpr(i1,i2)
269  ELSEIF(ivar.EQ.32) THEN
270  rold=coef(i1,i2)
271  ELSEIF(ivar.EQ.33) THEN
272  iold=icol(i1,i2,i3)
273  ELSEIF(ivar.EQ.34) THEN
274  rold=xsfx(i1,i2)
275  ELSEIF(ivar.EQ.35) THEN
276  iold=isig(i1,i2)
277  ELSEIF(ivar.EQ.36) THEN
278  rold=sigh(i1)
279  ELSEIF(ivar.EQ.37) THEN
280  iold=mwid(i1)
281  ELSEIF(ivar.EQ.38) THEN
282  rold=wids(i1,i2)
283  ELSEIF(ivar.EQ.39) THEN
284  iold=ngen(i1,i2)
285  ELSEIF(ivar.EQ.40) THEN
286  rold=xsec(i1,i2)
287  ELSEIF(ivar.EQ.41) THEN
288  chold2=proc(i1)
289  ELSEIF(ivar.EQ.42) THEN
290  rold=sigt(i1,i2,i3)
291  ELSEIF(ivar.EQ.43) THEN
292  rold=xpvmd(i1)
293  ELSEIF(ivar.EQ.44) THEN
294  rold=xpanl(i1)
295  ELSEIF(ivar.EQ.45) THEN
296  rold=xpanh(i1)
297  ELSEIF(ivar.EQ.46) THEN
298  rold=xpbeh(i1)
299  ELSEIF(ivar.EQ.47) THEN
300  rold=xpdir(i1)
301  ELSEIF(ivar.EQ.48) THEN
302  iold=imss(i1)
303  ELSEIF(ivar.EQ.49) THEN
304  rold=rmss(i1)
305  ELSEIF(ivar.EQ.50) THEN
306  rold=rvlam(i1,i2,i3)
307  ELSEIF(ivar.EQ.51) THEN
308  rold=rvlamp(i1,i2,i3)
309  ELSEIF(ivar.EQ.52) THEN
310  rold=rvlamb(i1,i2,i3)
311  ELSEIF(ivar.EQ.53) THEN
312  iold=itcm(i1)
313  ELSEIF(ivar.EQ.54) THEN
314  rold=rtcm(i1)
315  ENDIF
316 
317 C...Print current value of variable. Loop back.
318  IF(lnam.GE.lbit) THEN
319  chbit(lnam:14)=' '
320  chbit(15:60)=' has the value '
321  IF(msvar(ivar,1).EQ.1) THEN
322  WRITE(chbit(51:60),'(I10)') iold
323  ELSEIF(msvar(ivar,1).EQ.2) THEN
324  WRITE(chbit(47:60),'(F14.5)') rold
325  ELSEIF(msvar(ivar,1).EQ.3) THEN
326  chbit(53:60)=chold
327  ELSE
328  chbit(33:60)=chold
329  ENDIF
330  IF(mstu(13).GE.1) WRITE(mstu(11),5000) chbit(1:60)
331  llow=lhig
332  IF(llow.LT.ltot) goto 120
333  RETURN
334  ENDIF
335 
336 C...Read in new variable value.
337  IF(msvar(ivar,1).EQ.1) THEN
338  chini=' '
339  chini(lnam-lbit+11:10)=chbit(lnam+1:lbit)
340  READ(chini,'(I10)') inew
341  ELSEIF(msvar(ivar,1).EQ.2) THEN
342  chinr=' '
343  chinr(lnam-lbit+17:16)=chbit(lnam+1:lbit)
344  READ(chinr,*) rnew
345  ELSEIF(msvar(ivar,1).EQ.3) THEN
346  chnew=chbit(lnam+1:lbit)//' '
347  ELSE
348  chnew2=chbit(lnam+1:lbit)//' '
349  ENDIF
350 
351 C...Store new variable value.
352  IF(ivar.EQ.1) THEN
353  n=inew
354  ELSEIF(ivar.EQ.2) THEN
355  k(i1,i2)=inew
356  ELSEIF(ivar.EQ.3) THEN
357  p(i1,i2)=rnew
358  ELSEIF(ivar.EQ.4) THEN
359  v(i1,i2)=rnew
360  ELSEIF(ivar.EQ.5) THEN
361  mstu(i1)=inew
362  ELSEIF(ivar.EQ.6) THEN
363  paru(i1)=rnew
364  ELSEIF(ivar.EQ.7) THEN
365  mstj(i1)=inew
366  ELSEIF(ivar.EQ.8) THEN
367  parj(i1)=rnew
368  ELSEIF(ivar.EQ.9) THEN
369  kchg(i1,i2)=inew
370  ELSEIF(ivar.EQ.10) THEN
371  pmas(i1,i2)=rnew
372  ELSEIF(ivar.EQ.11) THEN
373  parf(i1)=rnew
374  ELSEIF(ivar.EQ.12) THEN
375  vckm(i1,i2)=rnew
376  ELSEIF(ivar.EQ.13) THEN
377  mdcy(i1,i2)=inew
378  ELSEIF(ivar.EQ.14) THEN
379  mdme(i1,i2)=inew
380  ELSEIF(ivar.EQ.15) THEN
381  brat(i1)=rnew
382  ELSEIF(ivar.EQ.16) THEN
383  kfdp(i1,i2)=inew
384  ELSEIF(ivar.EQ.17) THEN
385  chaf(i1,i2)=chnew
386  ELSEIF(ivar.EQ.18) THEN
387  mrpy(i1)=inew
388  ELSEIF(ivar.EQ.19) THEN
389  rrpy(i1)=rnew
390  ELSEIF(ivar.EQ.20) THEN
391  msel=inew
392  ELSEIF(ivar.EQ.21) THEN
393  msub(i1)=inew
394  ELSEIF(ivar.EQ.22) THEN
395  kfin(i1,i2)=inew
396  ELSEIF(ivar.EQ.23) THEN
397  ckin(i1)=rnew
398  ELSEIF(ivar.EQ.24) THEN
399  mstp(i1)=inew
400  ELSEIF(ivar.EQ.25) THEN
401  parp(i1)=rnew
402  ELSEIF(ivar.EQ.26) THEN
403  msti(i1)=inew
404  ELSEIF(ivar.EQ.27) THEN
405  pari(i1)=rnew
406  ELSEIF(ivar.EQ.28) THEN
407  mint(i1)=inew
408  ELSEIF(ivar.EQ.29) THEN
409  vint(i1)=rnew
410  ELSEIF(ivar.EQ.30) THEN
411  iset(i1)=inew
412  ELSEIF(ivar.EQ.31) THEN
413  kfpr(i1,i2)=inew
414  ELSEIF(ivar.EQ.32) THEN
415  coef(i1,i2)=rnew
416  ELSEIF(ivar.EQ.33) THEN
417  icol(i1,i2,i3)=inew
418  ELSEIF(ivar.EQ.34) THEN
419  xsfx(i1,i2)=rnew
420  ELSEIF(ivar.EQ.35) THEN
421  isig(i1,i2)=inew
422  ELSEIF(ivar.EQ.36) THEN
423  sigh(i1)=rnew
424  ELSEIF(ivar.EQ.37) THEN
425  mwid(i1)=inew
426  ELSEIF(ivar.EQ.38) THEN
427  wids(i1,i2)=rnew
428  ELSEIF(ivar.EQ.39) THEN
429  ngen(i1,i2)=inew
430  ELSEIF(ivar.EQ.40) THEN
431  xsec(i1,i2)=rnew
432  ELSEIF(ivar.EQ.41) THEN
433  proc(i1)=chnew2
434  ELSEIF(ivar.EQ.42) THEN
435  sigt(i1,i2,i3)=rnew
436  ELSEIF(ivar.EQ.43) THEN
437  xpvmd(i1)=rnew
438  ELSEIF(ivar.EQ.44) THEN
439  xpanl(i1)=rnew
440  ELSEIF(ivar.EQ.45) THEN
441  xpanh(i1)=rnew
442  ELSEIF(ivar.EQ.46) THEN
443  xpbeh(i1)=rnew
444  ELSEIF(ivar.EQ.47) THEN
445  xpdir(i1)=rnew
446  ELSEIF(ivar.EQ.48) THEN
447  imss(i1)=inew
448  ELSEIF(ivar.EQ.49) THEN
449  rmss(i1)=rnew
450  ELSEIF(ivar.EQ.50) THEN
451  rvlam(i1,i2,i3)=rnew
452  ELSEIF(ivar.EQ.51) THEN
453  rvlamp(i1,i2,i3)=rnew
454  ELSEIF(ivar.EQ.52) THEN
455  rvlamb(i1,i2,i3)=rnew
456  ELSEIF(ivar.EQ.53) THEN
457  itcm(i1)=inew
458  ELSEIF(ivar.EQ.54) THEN
459  rtcm(i1)=rnew
460  ENDIF
461 
462 C...Write old and new value. Loop back.
463  chbit(lnam:14)=' '
464  chbit(15:60)=' changed from to '
465  IF(msvar(ivar,1).EQ.1) THEN
466  WRITE(chbit(33:42),'(I10)') iold
467  WRITE(chbit(51:60),'(I10)') inew
468  IF(mstu(13).GE.1) WRITE(mstu(11),5000) chbit(1:60)
469  ELSEIF(msvar(ivar,1).EQ.2) THEN
470  WRITE(chbit(29:42),'(F14.5)') rold
471  WRITE(chbit(47:60),'(F14.5)') rnew
472  IF(mstu(13).GE.1) WRITE(mstu(11),5000) chbit(1:60)
473  ELSEIF(msvar(ivar,1).EQ.3) THEN
474  chbit(35:42)=chold
475  chbit(53:60)=chnew
476  IF(mstu(13).GE.1) WRITE(mstu(11),5000) chbit(1:60)
477  ELSE
478  chbit(15:88)=' changed from '//chold2//' to '//chnew2
479  IF(mstu(13).GE.1) WRITE(mstu(11),5100) chbit(1:88)
480  ENDIF
481  llow=lhig
482  IF(llow.LT.ltot) goto 120
483 
484 C...Format statement for output on unit MSTU(11) (by default 6).
485  5000 FORMAT(5x,a60)
486  5100 FORMAT(5x,a88)
487 
488  RETURN
489  END