COSMOS v7.655  COSMOSv7655
(AirShowerMC)
chAcolAdhoc.f
Go to the documentation of this file.
1 ! hadoron-A collision of my adhoc model.
2  subroutine chacoladhoc(pj, ia, iz, a, ntp)
3  implicit none
4 ! This is a Adhoc model of multiple production.
5 ! h-A collision is decomposed into multiple collision
6 ! of the leading particle, and for each collision
7 ! chncol is used with some reduction of the leading
8 ! particle energy for the 2nd, 3rd,... collisions.
9 ! Since the incident energy is high, we neglect
10 ! the multiple collisions at energy < 5 GeV.
11 !
12 
13 #include "Zptcl.h"
14 #include "Zcode.h"
15 #include "Zevhnp.h"
16 !
17  type(ptcl):: pj ! input projectile ptcl
18  integer ia ! input. mass no. of target
19  integer iz ! input. charge no. of target
20  type(ptcl):: a(*) ! output. produced ptcls
21  integer ntp ! number of produced ptcls
22 !
23  integer ncoll, tgtchg, i, n
24  type(ptcl):: aPtcl, tgt
25 ! real*8 eminSucCol/5./
26  real*8 eminSucCol/3./
27  integer icon, fails
28 !
29 ! Fermi momentum can be neglected ( E > Elund= 500 GeV)
30  if(sucint .eq. 0) then
31  call csampcollina(pj, ia, ncoll)
32  elseif(sucint .eq. 1) then
33  call csmpcolina2(pj, ia, ncoll)
34  else
35  call cerrormsg('SucInt has an invalid value', 0)
36  endif
37 ! fix target nucleon charge
38  call cfxtgtchg(ia, iz, tgtchg)
39 ! make target nucleon
40  call cmkptc(knuc, regptcl, tgtchg, tgt)
41 ! give 4 momentum
42  tgt%fm%p(1) = 0.
43  tgt%fm%p(2) = 0.
44  tgt%fm%p(3) = 0.
45  tgt%fm%p(4) = tgt%mass
46 !
47  fails = 0
48  icon = 1
49  do while( fails .lt. 10 .and. icon .ne. 0 )
50  call chncol(pj, tgt, a, ntp, icon)
51  if(icon .ne. 0) then
52  fails = fails + 1
53  endif
54  enddo
55 
56  if(icon .ne. 0) then
57 ! generation failed.
58  a(1) = pj
59  ntp = 1
60  goto 100
61  endif
62 
63  call cslpx2(.true.) ! specify that this is 2nd,3rd .. col.
64  do i = 2, ncoll
65 ! extract leading ptcl
66  aptcl = a(ntp)
67  if(aptcl%fm%p(4) .gt. eminsuccol) then
68  ntp = ntp - 1
69  call cfxtgtchg(ia, iz, tgtchg)
70  tgt%charge = tgtchg
71  call chncol(aptcl, tgt, a(ntp+1), n, icon)
72  if(icon .ne. 0) then
73  ntp = ntp + 1
74  a(ntp) = aptcl
75  goto 50
76  endif
77  ntp = ntp + n
78  endif
79  enddo
80  50 continue
81  call cslpx2(.false.) ! reset nucleus condition
82  100 continue
83  end
subroutine cerrormsg(msg, needrtn)
Definition: cerrorMsg.f:4
subroutine csmpcolina2(pj, ia, nc)
Definition: csmpColInA2.f:3
subroutine chncol(pj, tg, a, ntp, icon)
Definition: chncol.f:11
subroutine csampcollina(pj, ia, nc)
Definition: csampCollInA.f:28
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 true
Definition: cblkElemag.h:7
max ptcl codes in the kseethru ! subcode integer regptcl
Definition: Zcode.h:2
subroutine chacoladhoc(pj, ia, iz, a, ntp)
Definition: chAcolAdhoc.f:3
********************block data cblkHeavy ********************integer j data *HeavyG2symbol *data *HeavyG2code knuc
Definition: cblkHeavy.h:7
subroutine cfxtgtchg(ia, iz, tcg)
Definition: cfxTgtChg.f:2
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
subroutine cmkptc(code, subcode, charge, p)
Definition: cmkptc.f:15
Definition: Zptcl.h:75