COSMOS v7.655  COSMOSv7655
(AirShowerMC)
cconsvChg.f
Go to the documentation of this file.
1  subroutine cconsvchg(outc, a, ntp, icon)
2  implicit none
3 #include "Zptcl.h"
4 #include "Zcode.h"
5 
6  integer outc ! input. outc + sum of charge of a(i)...a(ntp) = 0
7  integer ntp ! input. number of paticles produced except for proj and tgt
8  type(ptcl):: a(ntp) ! input/output. partcles (except for proj and tgt)
9  integer icon ! output. 0--> o%k. 1--> n%g
10 
11 !
12 ! Total charge of 'a' is adjuested to be the same as
13 ! rproj.charge + rtgt.charge
14 !
15  integer sum, i, ncc, nnn
16  real*8 u
17  sum = 0.
18  do i = 1, ntp
19  sum = sum + a(i)%charge
20  enddo
21  sum = sum + outc
22  ncc = 0
23 
24  do while( sum .ne. 0 .and. ncc .lt. 10)
25  nnn = 0
26  do while (abs(sum) .ge. 2 .and. nnn .lt. 10)
27 ! very rare to have nnn > 10
28 !
29 ! charge 'sum' must be made to be 0
30 !
31  call rndc(u)
32  if(sum .gt. 0) then
33  if(u .lt. 0.3333d0) then
34  call cchgopposit(1, a, ntp,icon)
35  if(icon .eq. 0) then
36  sum = sum - 2
37  endif
38 ! elseif(u .lt. 0.6666d0) then
39 ! call cchg0(1, a, ntp, icon)
40 ! if(icon .eq. 0) then
41 ! sum = sum - 1
42 ! endif
43  else
44 ! call rndc(u)
45  call cchg0c(-1, a, ntp, icon)
46  if(icon .eq. 0) then
47  sum = sum - 1
48  call cchg0c(-1, a, ntp, icon)
49  if(icon .eq. 0) then
50  sum= sum-1
51  endif
52  endif
53 ! elseif(u .lt. 0.1) then
54 ! call cchg0(1, a, ntp, icon)
55 ! if(icon .eq. 0) then
56 ! sum = sum -1
57 ! endif
58 ! else
59 ! call cchgopposit(1, a, ntp, icon)
60 ! if(icon .eq. 0) then
61 ! sum = sum - 2
62 ! endif
63 ! endif
64  endif
65  else
66  if(u .lt. 0.3333d0) then
67  call cchgopposit(-1, a, ntp, icon)
68  if(icon .eq. 0) then
69  sum = sum + 2
70  endif
71 ! elseif(u .lt. 0.666d0) then
72 ! elseif(u .lt. 0.95d0) then
73 ! call cchg0(-1, a, ntp, icon)
74 ! if(icon .eq. 0) then
75 ! sum = sum + 1
76 ! endif
77  else
78  call rndc(u)
79  call cchg0c(1, a, ntp, icon)
80  if(icon .eq. 0) then
81  sum = sum + 1
82  call cchg0c(1, a, ntp, icon)
83  if(icon .eq. 0) then
84  sum = sum + 1
85  endif
86  endif
87 ! elseif(u .lt. 0.8d0) then
88 ! call cchg0(-1, a, ntp, icon)
89 ! if(icon .eq. 0) then
90 ! sum = sum + 1
91 ! endif
92 ! else
93 ! call cchgopposit(-1, a, ntp, icon)
94 ! if(icon .eq. 0) then
95 ! sum = sum + 2
96 ! endif
97 ! endif
98  endif
99  endif
100  nnn = nnn + 1
101  enddo
102  if(sum .eq. 1) then
103  call cchg0(1, a, ntp, icon)
104  if(icon .eq. 0) then
105  sum = 0
106  else
107  call cchg0c(-1, a, ntp, icon)
108  if(icon .eq. 0) then
109  sum = 0
110  endif
111  endif
112  elseif(sum .eq. -1) then
113  call cchg0(-1, a, ntp, icon)
114  if(icon .eq. 0) then
115  sum = 0
116  else
117  call cchg0c(1, a, ntp, icon)
118  if(icon .eq. 0) then
119  sum = 0
120  endif
121  endif
122  endif
123  if(sum .eq. 0) then
124  icon = 0
125  else
126  ncc = ncc + 1
127  icon = 1
128  endif
129  enddo
130  end
131 !
132  subroutine cchgopposit(chg, a, ntp, icon)
133  implicit none
134 #include "Zptcl.h"
135 #include "Zcode.h"
136 ! make one plus or minums charged ptcl into opposit charge
137  integer chg ! input. 1 or -1
138  integer ntp
139  type(ptcl):: a(ntp)
140  integer icon ! output. 0-> o%k
141  real*8 u
142  integer i, ncc
143  logical found
144 
145  found = .false.
146  ncc = 0
147  do while ( .not. found .and. ncc .lt. ntp*3)
148  call rndc(u)
149  i = ntp*u + 1
150  found = a(i)%charge .eq. chg .and.
151  * (a(i)%code .eq. kpion .or. a(i)%code .eq. kkaon)
152  ncc = ncc + 1
153  enddo
154 !
155 ! make this to opposit sign
156 !
157  if(found) then
158  icon = 0
159  a(i)%charge = -chg
160  else
161  icon = 1
162  endif
163  end
164 
165  subroutine cchg0(chg, a, ntp, icon)
166  implicit none
167 #include "Zptcl.h"
168 #include "Zcode.h"
169 
170 ! make one plus or minums charge ptcl into 0
171  integer chg ! input. 1 or -1
172  integer ntp
173  type(ptcl):: a(ntp)
174  integer icon
175 
176  real*8 u
177  integer i, ncc
178  logical found
179  integer code, subcode
180 
181  found = .false.
182  ncc = 0
183  do while ( .not. found .and. ncc .lt. ntp*3)
184  call rndc(u)
185  i = ntp*u + 1
186  found = a(i)%charge .eq. chg .and.
187  * (a(i)%code .eq. kpion .or. a(i)%code .eq. kkaon)
188  ncc = ncc + 1
189  enddo
190 !
191 ! make this to 0
192 !
193  if(found) then
194  icon = 0
195  a(i)%charge = 0
196  code = a(i)%code
197  if(code .eq. kpion) then
198  subcode = 0
199  else
200  call rndc(u)
201  if(u .lt. 0.5) then
202  call rndc(u)
203  if(u .lt. 0.5) then
204  subcode = k0s
205  else
206  subcode = -k0s
207  endif
208  else
209  call rndc(u)
210  if(u .lt. 0.5) then
211  subcode = k0l
212  else
213  subcode = -k0l
214  endif
215  endif
216  endif
217  call cmkptc(code, subcode, 0, a(i))
218  call cpm2e(a(i), a(i))
219  else
220  icon = 1
221  endif
222  end
223 !
224  subroutine cchg0c(chg, a, ntp, icon)
225  implicit none
226 #include "Zptcl.h"
227 #include "Zcode.h"
228 
229  integer chg
230  integer ntp
231  integer icon
232  type(ptcl):: a(ntp)
233  real*8 u
234  integer i, ncc
235  logical found
236 ! change neutral into charged
237  integer code, subcode
238 
239  found = .false.
240  ncc = 0
241 
242  do while ( .not. found .and. ncc .lt. ntp*3)
243  call rndc(u)
244  i = ntp*u + 1
245  found = a(i)%charge .eq. 0 .and.
246  * (a(i)%code .eq. kpion .or. a(i)%code .eq. kkaon)
247  ncc = ncc + 1
248  enddo
249  if( found ) then
250  a(i)%charge = chg
251  icon = 0
252  code = a(i)%code
253 ! remake paticle; since mass is diff.
254  call cmkptc(code, subcode, chg, a(i))
255  call cpm2e(a(i), a(i))
256  else
257  icon = 1
258  endif
259  end
260 
261 
k0l
max ptcl codes in the kseethru ! subcode integer k0l
Definition: Zcode.h:2
k0s
max ptcl codes in the kseethru ! subcode integer k0s
Definition: Zcode.h:2
kkaon
max ptcl codes in the kkaon
Definition: Zcode.h:2
rndc
subroutine rndc(u)
Definition: rnd.f:91
cchgopposit
subroutine cchgopposit(chg, a, ntp, icon)
Definition: cconsvChg.f:133
cchg0
subroutine cchg0(chg, a, ntp, icon)
Definition: cconsvChg.f:166
cchg0c
subroutine cchg0c(chg, a, ntp, icon)
Definition: cconsvChg.f:225
d0
block data cblkEvhnp ! currently usable models data RegMdls ad *special data *Cekaon d0
Definition: cblkEvhnp.h:5
cconsvchg
subroutine cconsvchg(outc, a, ntp, icon)
Definition: cconsvChg.f:2
cpm2e
subroutine cpm2e(p, q)
Definition: cpm2e.f:2
false
block data cblkElemag data *AnihiE ! Eposi< 1 TeV, anihilation considered *X0/365.667/, ! radiation length of air in kg/m2 *Ecrit/81.e-3/, ! critical energy of air in GeV *MaxComptonE/1./, ! compton is considered below 1 GeV *MaxPhotoE/1.e-3/, ! above this, PhotoElectric effect neg. *MinPhotoProdE/153.e-3/, ! below 153 MeV, no gp --> hadrons ! scattering const not MeV *Knockon ! knockon is considered Obsolete *PhotoProd false
Definition: cblkElemag.h:7
cmkptc
subroutine cmkptc(code, subcode, charge, p)
Definition: cmkptc.f:15
ptcl
Definition: Zptcl.h:75
kpion
max ptcl codes in the kpion
Definition: Zcode.h:2