COSMOS v7.655  COSMOSv7655
(AirShowerMC)
getBasicHistoInfo.f
Go to the documentation of this file.
1 !
2 ! Assume only 1 layer is contained in the -t.hist file
3 ! If multi layers are contained, need a lot of modification
4 !
5 ! read binary or ascii time histogram file and
6 ! get basic information: evid and write it in a
7 ! given file.
8 ! usage: make -f getBasicHistoInfo.mk
9 ! ./getBasicHistoInfo binOrascii webonly filename tempfile
10 !
11 ! where binOrascii is 1 for ascii input file
12 ! 2 for binary //
13 ! webonly: histo is from mkLDD or from FDD
14 ! filenname is path to the input histogram file
15 ! (<256 char)
16 ! tempfle: for memo to be used later.
17  implicit none
18  integer binorascii
19  integer count, status
20  character*80 buf
21 
22  count = nargs()
23  if(count .ne. 5) then
24  write(0,*)
25  * " must give bin webonly filename tempfile as arguments"
26  write(0,*) " bin=1-->input is ascii file"
27  write(0,*) " bin=2--> binary file"
28  write(0,*)
29  * "webonly=0-->input is made from mkLDD"
30  * " (core region data exists) "
31  write(0,*)
32  * "webonly=1-->input is made from FDD rawdata"
33  * "(no core region data) "
34  write(0,*) " filename: path to the input file"
35  write(0,*) " tempfile: path to the temporary working file"
36  write(0,*) " "
37  write(0,*) " you gave ", count-1, " arguments"
38  call getarg(1, buf, status)
39  write(0,*) " The first one was ", buf
40  stop 111
41  endif
42  call getarg(1, buf, status)
43  read(buf,*) binorascii
44  if(binorascii .ne. 1 .and. binorascii.ne. 2) then
45  write(0,*) ' error input to binOrascii=',binorascii
46  stop 111
47  endif
48 
49 
50  if(binorascii .eq. 1) then
51 ! ascii file
52  call proctimeascii
53  else
54 ! bin file
55  call proctimebin
56  endif
57  end
58 
59  subroutine proctimebin
60  implicit none
61 #include "ZprivateSub.h"
62 #include "../../Hist/Z90histc.h"
63 #include "../../Hist/Z90histo.h"
64 #include "../../Hist/Z90hist1.h"
65  character*80 buf
66 
67  type(histogram1) h10 ! 1D histogram area
68 
69  character*6 histid0 ! get histogram id here
70  integer icon
71  real normf
72  data normf/-1.0/ ! use normalization as already done
73  integer ansites
74  data ansites/1/ ! number of layers where histogram was taken
75  integer fnoT/31/ ! file number for hist
76  integer fnoW/32/ ! file number for working
77  character*256 filename, tempfile
78 
79  integer ir, ifai
80  integer code
81  integer nbinhisto, mode, status, webonly
82  integer kwhistReadAscii
83  integer i
84 
85 
86  call getarg(2, buf, status)
87  read(buf, *) webonly
88  call getarg(3, filename, status)
89 ! write(0,*) status, filename
90  call getarg(4, tempfile, status)
91 
92  open(fnot, file=filename,
93  * iostat=status, access='sequential',
94  * form='unformatted', action='read')
95  if(status .ne. 0 ) then
96  write(0,*) ' cannot open file ='
97  write(0,*) filename
98  stop 111
99  endif
100  open(fnow, file=tempfile,
101  * iostat=status, access='sequential',
102  * form='formatted', action='write')
103  if(status .ne. 0 ) then
104  write(0,*) ' cannot open file ='
105  write(0,*) tempfile
106  stop 222
107  endif
108 
109 ! skip time data for core region
110  if(webonly .eq. 0) then
111  do i = 1, ansites
112  do code = 1, 4
113  read( fnot, end=100 ) histid0
114  if( histid0 .ne. '#hist1' ) then
115  write(0,*) ' histogram is not 1D: ',histid0
116  stop 111
117  endif
118 !/////////
119  write(0,*) ' reading core region'
120 !/////////////
121  call kwhistr(h10, fnot, icon)
122  call kwhists(h10, normf)
123 ! deallocate
124  call kwhistd( h10 )
125  enddo
126  enddo
127  endif
128 ! web sector region
129 ! open memo file
130 !//////////////
131  write(0,*) ' reading web region'
132 !//////////////
133  do i = 1, ansites
134  do code = 1, 4
135  do ifai= 1, nfai
136  do ir= 1, nrbin
137  read( fnot, end=100 ) histid0
138  if( histid0 .ne. '#hist1' ) then
139  write(0,*) ' histogram is not 1-D: ',histid0
140  stop 111
141  endif
142  call kwhistr(h10, fnot, icon)
143  write(fnow,'(a)') h10%c%id
144 ! deallocate
145  call kwhistd( h10 )
146  close(fnow)
147  close(fnot)
148  return ! *********
149  enddo
150  enddo
151  enddo
152  enddo
153  return
154  100 continue
155  write(0,*) ' unexpected EOF '
156  stop 2345
157 ! **********************
158  entry proctimeascii
159 ! **********************
160 
161  call getarg(2, buf, status)
162  read(buf, *) webonly
163  call getarg(3, filename, status)
164 ! write(0,*) status, filename
165  call getarg(4, tempfile, status)
166  open(fnot, file=filename,
167  * iostat=status, access='sequential',
168  * form='formatted', action='read')
169  if(status .ne. 0 ) then
170  write(0,*) ' cannot open file ='
171  write(0,*) filename
172  stop 111
173  endif
174  open(fnow, file=tempfile,
175  * iostat=status, access='sequential',
176  * form='formatted', action='write')
177  if(status .ne. 0 ) then
178  write(0,*) ' cannot open file ='
179  write(0,*) tempfile
180  stop 111
181  endif
182 
183  if(webonly .eq. 0 ) then
184 ! skip time data for core region
185  do i = 1, ansites
186  do code = 1, 4
187  nbinhisto=kwhistreadascii(h10, fnot)
188  if(nbinhisto .le. 0 ) then
189  write(0,*) ' ascii read failed'
190  stop 111
191  endif
192  call kwhists(h10, normf)
193 
194 ! deallocate
195  call kwhistd( h10 )
196  enddo
197  enddo
198  endif
199 ! web sector region
200  do i = 1, ansites
201  do code = 1, 4
202  do ifai= 1, nfai
203  do ir= 1, nrbin
204  nbinhisto=kwhistreadascii(h10, fnot)
205  if(nbinhisto .le. 0 ) then
206  write(0,*) ' ascii read failed'
207  stop 111
208  endif
209  write(fnow,'(a)') h10%c%id
210 ! deallocate
211  call kwhistd( h10 )
212  close(fnow)
213  close(fnot)
214  return ! *********
215  enddo
216  enddo
217  enddo
218  enddo
219  end
kwhistd
void kwhistd(struct histogram1 *h)
nrbin
! timing nrbin
Definition: Zprivate2.h:12
kwhistr
void kwhistr(struct histogram1 *h, FILE *bfnor, int icon)
kwhists
void kwhists(struct histogram1 *h, float inorm)
proctimebin
subroutine proctimebin
Definition: getBasicHistoInfo.f:60
nfai
! timing nfai
Definition: Zprivate2.h:12