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) stop 'must give 3 files and flag '
28 
29  skelin = stro(1)
30  numbin = stro(2)
31  read( stro(3), * ) withir
32  mskel = stro(4)
33 
34  open(rdev, file=skelin(1:klena(skelin)), form='unformatted',
35  * status='old')
36 
37  open(ndev, file=numbin(1:klena(numbin)), form='formatted',
38  * status='old')
39 
40  open(mdev, file=mskel(1:klena(mskel)), form='unformatted',
41  * status='unknown')
42 
43 
44  do while(.true.)
45 
46  if(withir .eq. 0) then
47  read(ndev, *, end= 1000) nev
48  else
49  read(ndev, *, end= 1000) irevent, nev
50  endif
51  copy = .false.
52  do while (.not. copy)
53  read(rdev, end= 1000) cumnum, num, irevent, zfirst
54  if(cumnum .gt. nev) then
55  write(msg,*) 'specified event #=',nev,
56  * ' not exist in skeleton-node file'
57  call cerrormsg(msg, 1)
58  write(msg,*) 'skip to event=',cumnum
59  call cerrormsg(msg, 1)
60 
61  do while(nev .lt. cumnum)
62  if(withir .eq. 0) then
63  read(ndev, *, end= 1000) nev
64  else
65  read(ndev, *, end= 1000) irevent, nev
66  endif
67  enddo
68  endif
69  copy =cumnum .eq. nev
70  if(copy) then
71  write(mdev) cumnum, num, irevent, zfirst
72  endif
73  call cgethes(rdev)
74  nlow = 1
75  do while (nlow .ne. -1)
76  read(rdev) nlow, p
77  if(copy) then
78  write(mdev) nlow, p
79  endif
80  do i = 1, nlow
81  read(rdev) c
82  if(copy) then
83  write(mdev) c
84  endif
85  enddo
86  enddo
87  enddo
88  enddo
89  1000 continue
90  call cerrormsg(
91  * ' all events copied', 1)
92  end
93 
94 
95  subroutine cgethes(from)
96  implicit none
97 #include "Zprivate.h"
98  integer from
99 !
100 
101  integer i
102 
103  read(from) np
104  if(copy) then
105  write(mdev) np
106  endif
107  do i = 1, np
108  read(from) o(i)
109  if(copy) then
110  write(mdev) o(i)
111  endif
112  enddo
113 
114  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