COSMOS v7.655  COSMOSv7655
(AirShowerMC)
ranseeascii.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(3), 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, 3
23  stro(i) = ' '
24  enddo
25 !
26  call ksplit(str, 80, 3, stro, nr)
27  if(nr .lt. 3) stop 'must give 2 files and flag '
28 
29  skelin = stro(1)
30  numbin = stro(2)
31  read( stro(3), * ) withir
32 
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 
41  do while(.true.)
42 
43  if(withir .eq. 0) then
44  read(ndev, *, end= 1000) nev
45  else
46  read(ndev, *, end= 1000) irevent, nev
47  endif
48  copy = .false.
49  do while (.not. copy)
50  read(rdev, end= 1000) cumnum, num, irevent, zfirst
51  if(cumnum .gt. nev) then
52  write(msg,*) 'specified event #=',nev,
53  * ' not exist in skeleton-node file'
54  call cerrormsg(msg, 1)
55  write(msg,*) 'skip to event=',cumnum
56  call cerrormsg(msg, 1)
57 
58  do while(nev .lt. cumnum)
59  if(withir .eq. 0) then
60  read(ndev, *, end= 1000) nev
61  else
62  read(ndev, *, end= 1000) irevent, nev
63  endif
64  enddo
65  endif
66  copy =cumnum .eq. nev
67  if(copy) then
68  call toasciih( cumnum, num, irevent, zfirst)
69  endif
70  call cgethes(rdev)
71  nlow = 1
72  do while (nlow .ne. -1)
73  read(rdev) nlow, p
74  if(copy) then
75  call toasciin(nlow, p)
76  endif
77  do i = 1, nlow
78  read(rdev) c
79  if(copy) then
80  call toasciic(c)
81  endif
82  enddo
83  enddo
84  enddo
85  enddo
86  1000 continue
87  call cerrormsg(
88  * ' all events finished', 1)
89  end
90 
91 
92  subroutine cgethes(from)
93  implicit none
94 #include "Zprivate.h"
95  integer from
96 !
97 
98  integer i
99 
100  read(from) np
101  if(copy) then
102  call toasciinp(np)
103  endif
104  do i = 1, np
105  read(from) o(i)
106  if(copy) then
107  call toasciihe(o(i))
108  endif
109  enddo
110 
111  end
ksplit
subroutine ksplit(a, m, n, b, nr)
Definition: ksplit.f:2
cerrormsg
subroutine cerrormsg(msg, needrtn)
Definition: cerrorMsg.f:4
toasciih
subroutine toasciih(cnum, num, ir, zf)
Definition: asciiprint.f:2
i
nodes i
Definition: cstdatmos0.fNew2.h:93
toasciinp
subroutine toasciinp(n)
Definition: asciiprint.f:51
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
toasciihe
subroutine toasciihe(he)
Definition: asciiprint.f:62
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
toasciic
subroutine toasciic(cc)
Definition: asciiprint.f:41
toasciin
subroutine toasciin(nlow, pp)
Definition: asciiprint.f:22
c
dE dx *! Nuc Int sampling table c
Definition: cblkMuInt.h:130