COSMOS v7.655  COSMOSv7655
(AirShowerMC)
randomsel.f
Go to the documentation of this file.
1  implicit none
2 #include "Zprivate.h"
3 #include "Ztrack.h"
4 
5 
6 
7  integer num, cumnum, irevent(2), i, nr, ndev, withir, nev
8  type(track):: Zfirst
9  character*160 str, msg
10  character*80 skelin, stro(4), numbin
11 
12 
13  integer klena, nlow
14 
15  mdev = 71
16  rdev = 70
17  ndev = 69
18 
19  str = ' '
20  read(*,'(a)') str
21 !
22  do i = 1, 4
23  stro(i) = ' '
24  enddo
25 !
26  call ksplit(str, 80, 4, stro, nr)
27  if(nr .lt. 4) then
28  write(0,*) 'give name of '
29  write(0,*) ' input SkelFile'
30  write(0,*) ' event num file'
31  write(0,*) ' ouput SkelFile'
32  write(0,*) ' 1/0 depending on event num file has IR'
33  write(0,*)
34  * 'e.g echo "skelfile Seed outskel 0" | randomselPCLinuxIFC'
35  stop 111
36  endif
37 
38  skelin = stro(1)
39  numbin = stro(2)
40  mskel = stro(3)
41  read( stro(4), * ) withir
42  open(rdev, file=skelin(1:klena(skelin)), form='unformatted',
43  * status='old')
44 
45  open(ndev, file=numbin(1:klena(numbin)), form='formatted',
46  * status='old')
47 
48  open(mdev, file=mskel(1:klena(mskel)), form='unformatted',
49  * status='unknown')
50 
51 
52  do while(.true.)
53 
54  if(withir .eq. 0) then
55  read(ndev, *, end= 1000) nev
56  else
57  read(ndev, *, end= 1000) irevent, nev
58  endif
59  copy = .false.
60  do while (.not. copy)
61  read(rdev, end= 1000) cumnum, num, irevent, zfirst
62  if(cumnum .gt. nev) then
63  write(msg,*) 'specified event #=',nev,
64  * ' not exist in skeleton-node file'
65  call cerrormsg(msg, 1)
66  write(msg,*) 'skip to event=',cumnum
67  call cerrormsg(msg, 1)
68 
69  do while(nev .lt. cumnum)
70  if(withir .eq. 0) then
71  read(ndev, *, end= 1000) nev
72  else
73  read(ndev, *, end= 1000) irevent, nev
74  endif
75  enddo
76  endif
77  copy =cumnum .eq. nev
78  if(copy) then
79  write(mdev) cumnum, num, irevent, zfirst
80  endif
81  call cgethes(rdev)
82  nlow = 1
83  do while (nlow .ne. -1)
84  read(rdev) nlow, p
85  if(copy) then
86  write(mdev) nlow, p
87  endif
88  do i = 1, nlow
89  read(rdev) c
90  if(copy) then
91  write(mdev) c
92  endif
93  enddo
94  enddo
95  enddo
96  enddo
97  1000 continue
98  call cerrormsg(
99  * ' all events copied', 1)
100  end
101 
102 
103  subroutine cgethes(from)
104  implicit none
105 #include "Zprivate.h"
106  integer from
107 !
108 
109  integer i
110 
111  read(from) np
112  if(copy) then
113  write(mdev) np
114  endif
115  do i = 1, np
116  read(from) o(i)
117  if(copy) then
118  write(mdev) o(i)
119  endif
120  enddo
121 
122  end
ksplit
subroutine ksplit(a, m, n, b, nr)
Definition: ksplit.f:2
cerrormsg
subroutine cerrormsg(msg, needrtn)
Definition: cerrorMsg.f:4
i
nodes i
Definition: cstdatmos0.fNew2.h:93
track
Definition: Ztrack.h:44
true
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
p
********************block data cblkHeavy ********************integer j data *HeavyG2symbol p
Definition: cblkHeavy.h:7
cgethes
subroutine cgethes(from)
Definition: chookFlesh.f:322
o
struct ob o[NpMax]
Definition: Zprivate.h:34
klena
integer function klena(cha)
Definition: klena.f:20
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
c
dE dx *! Nuc Int sampling table c
Definition: cblkMuInt.h:130