Analysis Software
Documentation for sPHENIX simulation software
 All Classes Namespaces Files Functions Variables Typedefs Enumerations Enumerator Friends Macros Groups Pages
pyonof.f
Go to the documentation of this file. Or view the newest version in sPHENIX GitHub for file pyonof.f
1 
2 C*********************************************************************
3 
4 C...PYONOF
5 C...Switches on and off decay channel by search for match.
6 
7  SUBROUTINE pyonof(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/pydat1/mstu(200),paru(200),mstj(200),parj(200)
15  common/pydat3/mdcy(500,3),mdme(8000,2),brat(8000),kfdp(8000,5)
16  SAVE /pydat1/,/pydat3/
17 C...Local arrays and character variables.
18  INTEGER kfcmp(10),kftmp(10)
19  CHARACTER chin*(*),chtmp*104,chfix*104,chmode*10,chcode*8,
20  &chalp(2)*26
21  DATA chalp/'abcdefghijklmnopqrstuvwxyz',
22  &'ABCDEFGHIJKLMNOPQRSTUVWXYZ'/
23 
24 C...Determine length of character variable.
25  chtmp=chin//' '
26  lbeg=0
27  100 lbeg=lbeg+1
28  IF(chtmp(lbeg:lbeg).EQ.' ') goto 100
29  lend=lbeg-1
30  105 lend=lend+1
31  IF(lend.LE.100.AND.chtmp(lend:lend).NE.'!') goto 105
32  110 lend=lend-1
33  IF(chtmp(lend:lend).EQ.' ') goto 110
34  len=1+lend-lbeg
35  chfix(1:len)=chtmp(lbeg:lend)
36 
37 C...Find colon separator and particle code.
38  lcolon=0
39  120 lcolon=lcolon+1
40  IF(chfix(lcolon:lcolon).NE.':') goto 120
41  chcode=' '
42  chcode(10-lcolon:8)=chfix(1:lcolon-1)
43  READ(chcode,'(I8)',err=300) kf
44  kc=pycomp(kf)
45 
46 C...Done if unknown code or no decay channels.
47  IF(kc.EQ.0) THEN
48  CALL pyerrm(18,'(PYONOF:) unrecognized particle '//chcode)
49  RETURN
50  ENDIF
51  idcbeg=mdcy(kc,2)
52  idclen=mdcy(kc,3)
53  IF(idcbeg.EQ.0.OR.idclen.EQ.0) THEN
54  CALL pyerrm(18,'(PYONOF:) no decay channels for '//chcode)
55  RETURN
56  ENDIF
57 
58 C...Find command name up to blank or equal sign.
59  lsep=lcolon
60  130 lsep=lsep+1
61  IF(lsep.LE.len.AND.chfix(lsep:lsep).NE.' '.AND.
62  &chfix(lsep:lsep).NE.'=') goto 130
63  chmode=' '
64  lmode=lsep-lcolon-1
65  chmode(1:lmode)=chfix(lcolon+1:lsep-1)
66 
67 C...Convert to uppercase.
68  DO 150 lcom=1,lmode
69  DO 140 lalp=1,26
70  IF(chmode(lcom:lcom).EQ.chalp(1)(lalp:lalp))
71  & chmode(lcom:lcom)=chalp(2)(lalp:lalp)
72  140 CONTINUE
73  150 CONTINUE
74 
75 C...Identify command. Failed if not identified.
76  mode=0
77  IF(chmode.EQ.'ALLOFF') mode=1
78  IF(chmode.EQ.'ALLON') mode=2
79  IF(chmode.EQ.'OFFIFANY') mode=3
80  IF(chmode.EQ.'ONIFANY') mode=4
81  IF(chmode.EQ.'OFFIFALL') mode=5
82  IF(chmode.EQ.'ONIFALL') mode=6
83  IF(chmode.EQ.'OFFIFMATCH') mode=7
84  IF(chmode.EQ.'ONIFMATCH') mode=8
85  IF(mode.EQ.0) THEN
86  CALL pyerrm(18,'(PYONOF:) unknown command '//chmode)
87  RETURN
88  ENDIF
89 
90 C...Simple cases when all on or all off.
91  IF(mode.EQ.1.OR.mode.EQ.2) THEN
92  WRITE(mstu(11),1000) kf,chmode
93  DO 160 idc=idcbeg,idcbeg+idclen-1
94  IF(mdme(idc,1).LT.0) goto 160
95  mdme(idc,1)=mode-1
96  160 CONTINUE
97  RETURN
98  ENDIF
99 
100 C...Identify matching list.
101  ncmp=0
102  lbeg=lsep
103  170 lbeg=lbeg+1
104  IF(lbeg.GT.len) goto 190
105  IF(lbeg.LT.len.AND.(chfix(lbeg:lbeg).EQ.' '.OR.
106  &chfix(lbeg:lbeg).EQ.'='.OR.chfix(lbeg:lbeg).EQ.',')) goto 170
107  lend=lbeg-1
108  180 lend=lend+1
109  IF(lend.LT.len.AND.chfix(lend:lend).NE.' '.AND.
110  &chfix(lend:lend).NE.'='.AND.chfix(lend:lend).NE.',') goto 180
111  IF(lend.LT.len) lend=lend-1
112  chcode=' '
113  chcode(8-lend+lbeg:8)=chfix(lbeg:lend)
114  READ(chcode,'(I8)',err=300) kfread
115  ncmp=ncmp+1
116  kfcmp(ncmp)=iabs(kfread)
117  lbeg=lend
118  IF(ncmp.LT.10) goto 170
119  190 CONTINUE
120  WRITE(mstu(11),1100) kf,chmode,(kfcmp(icmp),icmp=1,ncmp)
121 
122 C...Only one matching required.
123  IF(mode.EQ.3.OR.mode.EQ.4) THEN
124  DO 220 idc=idcbeg,idcbeg+idclen-1
125  IF(mdme(idc,1).LT.0) goto 220
126  DO 210 ikf=1,5
127  kfnow=iabs(kfdp(idc,ikf))
128  IF(kfnow.EQ.0) goto 210
129  DO 200 icmp=1,ncmp
130  IF(kfcmp(icmp).EQ.kfnow) THEN
131  mdme(idc,1)=mode-3
132  goto 220
133  ENDIF
134  200 CONTINUE
135  210 CONTINUE
136  220 CONTINUE
137  RETURN
138  ENDIF
139 
140 C...Multiple matchings required.
141  DO 260 idc=idcbeg,idcbeg+idclen-1
142  IF(mdme(idc,1).LT.0) goto 260
143  ntmp=ncmp
144  DO 230 itmp=1,ntmp
145  kftmp(itmp)=kfcmp(itmp)
146  230 CONTINUE
147  nfin=0
148  DO 250 ikf=1,5
149  kfnow=iabs(kfdp(idc,ikf))
150  IF(kfnow.EQ.0) goto 250
151  nfin=nfin+1
152  DO 240 itmp=1,ntmp
153  IF(kftmp(itmp).EQ.kfnow) THEN
154  kftmp(itmp)=kftmp(ntmp)
155  ntmp=ntmp-1
156  goto 250
157  ENDIF
158  240 CONTINUE
159  250 CONTINUE
160  IF(ntmp.EQ.0.AND.mode.LE.6) mdme(idc,1)=mode-5
161  IF(ntmp.EQ.0.AND.nfin.EQ.ncmp.AND.mode.GE.7)
162  & mdme(idc,1)=mode-7
163  260 CONTINUE
164  RETURN
165 
166 C...Error exit for impossible read of particle code.
167  300 CALL pyerrm(18,'(PYONOF:) could not interpret particle code '
168  &//chcode)
169 
170 C...Formats for output.
171  1000 FORMAT(' Decays for',i8,' set ',a10)
172  1100 FORMAT(' Decays for',i8,' set ',a10,' if match',10i8)
173 
174  RETURN
175  END