/[PAMELA software]/DarthVader/TrackerLevel2/src/F77/readallparam.f
ViewVC logotype

Contents of /DarthVader/TrackerLevel2/src/F77/readallparam.f

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.2 - (show annotations) (download)
Tue May 30 16:30:37 2006 UTC (18 years, 6 months ago) by pam-fi
Branch: MAIN
CVS Tags: v0r02, v2r01, v1r01beta, v1r00, v1r01, v3r04, v3r05, v3r06, v3r00, v3r03, v2r00BETA
Changes since 1.1: +26 -13 lines
Error handling from F77 routine / Fixed some bugs with default calibration

1
2 ************************************************************
3
4 subroutine readvkmask
5
6 include 'commontracker.f'
7 include 'calib.f'
8 include 'common_c2f.f' !<<<< C2F
9
10 c2f_error = 0
11
12 c if(C2F_DEBUG.eq.1)print *
13 if(verbose)print *
14 $ ,c2f_path(1:c2f_pathlen)//'trk-maskvk.dat'
15 open(10,
16 $ FILE=c2f_path(1:c2f_pathlen)//'trk-maskvk.dat' !<<<< C2F
17 $ ,STATUS='OLD'
18 $ ,IOSTAT=iostat
19 $ )
20 if(iostat.ne.0)then
21 c if(C2F_DEBUG.eq.1)
22 if(debug)
23 $ print*,'READVKMASK: *** Error opening file ***'
24 c2f_error = 1
25 return
26 endif
27 do iv=1,nviews
28 read(10,*
29 $ ,IOSTAT=iostat
30 $ )
31 $ (mask_vk(iv,i),i=1,24)
32 if(iostat.ne.0)then
33 c if(C2F_DEBUG.eq.1)
34 if(debug)
35 $ print*,'READVKMASK: *** Error reading file ***'
36 c2f_error = 1
37 goto 1000
38 endif
39 enddo
40 1000 close(10)
41 1001 continue
42 return
43 end
44
45
46 ************************************************************
47
48 subroutine readmipparam
49
50 include 'commontracker.f'
51 include 'calib.f'
52 include 'common_c2f.f' !<<<< C2F
53
54 character*60 fname_param
55 c2f_error = 0
56 201 format('trk-LADDER',i1,'-mip.dat')
57 do ilad=1,nladders_view
58 write(fname_param,201)ilad
59 c if(C2F_DEBUG.eq.1)print *
60 if(VERBOSE)print *
61 $ ,c2f_path(1:c2f_pathlen)!<<<< C2F
62 $ //fname_param(1:LNBLNK(fname_param))
63 open(10,
64 $ FILE=c2f_path(1:c2f_pathlen)!<<<< C2F
65 $ //fname_param(1:LNBLNK(fname_param))
66 $ ,STATUS='OLD'
67 $ ,IOSTAT=iostat
68 $ )
69 if(iostat.ne.0)then
70 c if(C2F_DEBUG.eq.1)print*
71 if(DEBUG)print*
72 $ ,'READMIPPARAM: *** Error opening file *** '
73 c2f_error = 1
74 return
75 endif
76 do iv=1,nviews
77 read(10,*
78 $ ,IOSTAT=iostat
79 $ )pip,
80 $ mip(int(pip),ilad)
81 if(iostat.ne.0)then
82 c2f_error = 1
83 goto 1000
84 endif
85 enddo
86 1000 close(10)
87 enddo
88
89 return
90 end
91 *** * * * *** * * * *** * * * *** * * * *** * * * *** * * * ***
92 subroutine readchargeparam
93
94
95 include 'commontracker.f'
96 include 'calib.f'
97 include 'common_c2f.f' !<<<< C2F
98 character*60 fname_param
99 c2f_error = 0
100 201 format('charge-l',i1,'.dat')
101 do ilad=1,nladders_view
102 write(fname_param,201)ilad
103 c if(C2F_DEBUG.eq.1)print *
104 if(VERBOSE)print *
105 $ ,c2f_path(1:c2f_pathlen)!<<<< C2F
106 $ //fname_param(1:LNBLNK(fname_param))
107 open(10,
108 $ FILE=c2f_path(1:c2f_pathlen)!<<<< C2F
109 $ //fname_param(1:LNBLNK(fname_param))
110 $ ,STATUS='OLD'
111 $ ,IOSTAT=iostat
112 $ )
113 if(iostat.ne.0)then
114 c2f_error = 1
115 return
116 endif
117 do ip=1,nplanes
118 read(10,*
119 $ ,IOSTAT=iostat
120 $ )pip,
121 $ kch(ip,ilad),cch(ip,ilad),sch(ip,ilad)
122 if(iostat.ne.0)then
123 c2f_error = 1
124 goto 1000
125 endif
126 enddo
127 1000 close(10)
128 enddo
129
130 return
131 end
132 *** * * * *** * * * *** * * * *** * * * *** * * * *** * * * ***
133 subroutine readetaparam
134 * -----------------------------------------
135 * read eta2,3,4 calibration parameters
136 * and fill variables:
137 *
138 * eta2(netabin,nladders_view,nviews)
139 * eta3(2*netabin,nladders_view,nviews)
140 * eta4(2*netabin,nladders_view,nviews)
141 *
142 include 'commontracker.f'
143 include 'calib.f'
144 include 'common_c2f.f' !<<<< C2F
145
146 character*40 fname_binning
147 character*40 fname_param
148
149
150 c2f_error = 0
151
152 ******retrieve ANGULAR BINNING info
153 fname_binning='binning.dat'
154 c if(C2F_DEBUG.eq.1)
155 if(VERBOSE)
156 $ print *
157 $ ,c2f_path(1:c2f_pathlen) !<<<< C2F
158 $ //fname_binning(1:LNBLNK(fname_binning))
159 open(10,
160 $ FILE=c2f_path(1:c2f_pathlen) !<<<< C2F
161 $ //fname_binning(1:LNBLNK(fname_binning))
162 $ ,STATUS='OLD'
163 $ ,IOSTAT=iostat
164 $ )
165 if(iostat.ne.0)then
166 c if(C2F_DEBUG.eq.1)
167 if(DEBUG)
168 $ print*,'READETAPARAM: *** Error in opening file *** '
169 c2f_error = 1
170 return
171 endif
172 c print*,'---- ANGULAR BINNING ----'
173 c print*,'Bin - angL - angR'
174 101 format(i2,' ',f6.2,' ',f6.2)
175 xnn=0
176 do ibin=1,nangmax
177 read(10,*
178 $ ,IOSTAT=iostat
179 $ )xnn,angL(ibin),angR(ibin)
180 if(iostat.ne.0)goto 1000
181 c write(*,101)int(xnn),angL(ibin),angR(ibin)
182 enddo
183 1000 nangbin=int(xnn)
184 close(10)
185 if(nangbin.eq.0)c2f_error = 1
186 c print*,'-------------------------'
187 c print*,nangbin
188
189
190
191 do ieta=2,4 !loop on eta 2,3,4
192 ******retrieve correction parameters
193 200 format(' Opening eta',i1,' files...')
194 c if(C2F_DEBUG.eq.1)write(*,200)ieta
195 if(VERBOSE)write(*,200)ieta
196
197 201 format('eta',i1,'-bin',i1,'-l',i1,'.dat')
198 202 format('eta',i1,'-bin',i2,'-l',i1,'.dat')
199 do iang=1,nangbin
200 do ilad=1,nladders_view
201 if(iang.lt.10)write(fname_param,201)ieta,iang,ilad
202 if(iang.ge.10)write(fname_param,202)ieta,iang,ilad
203 open(10,
204 c $ FILE=eta_parampath(1:eta_pathlen) !<<<< C2F
205 $ FILE=c2f_path(1:c2f_pathlen) !<<<< C2F
206 $ //fname_param(1:LNBLNK(fname_param))
207 $ ,STATUS='OLD'
208 $ ,IOSTAT=iostat
209 $ )
210 if(iostat.ne.0)then
211 c if(C2F_DEBUG.eq.1)
212 if(DEBUG)
213 $ print*,'READETAPARAM: ** Error opening file ** '
214 $ ,c2f_path(1:c2f_pathlen)
215 $ //fname_param(1:LNBLNK(fname_param))
216 c2f_error = 1
217 return
218 endif
219 netaval=0
220 do ival=1,netavalmax
221 if(ieta.eq.2)read(10,*
222 $ ,IOSTAT=iostat
223 $ )
224 $ eta2(ival,iang),
225 $ (feta2(ival,iv,ilad,iang),iv=1,nviews)
226 if(ieta.eq.3)read(10,*
227 $ ,IOSTAT=iostat
228 $ )
229 $ eta3(ival,iang),
230 $ (feta3(ival,iv,ilad,iang),iv=1,nviews)
231 if(ieta.eq.4)read(10,*
232 $ ,IOSTAT=iostat
233 $ )
234 $ eta4(ival,iang),
235 $ (feta4(ival,iv,ilad,iang),iv=1,nviews)
236 if(iostat.ne.0)then
237 if(netaval.eq.0)then
238 c if(C2F_DEBUG.eq.1)print*,'READETAPARAM: '
239 if(DEBUG)print*,'READETAPARAM: '
240 $ //'*** Error reading file *** '
241 $ ,c2f_path(1:c2f_pathlen)
242 $ //fname_param(1:LNBLNK(fname_param))
243 $ ,' (netaval=',netaval,')'
244 c2f_error = 1
245 endif
246 goto 2000
247 endif
248 netaval=netaval+1
249 enddo
250 2000 close(10)
251 * print*,'... done'
252 enddo
253 enddo
254
255 enddo !end loop on eta 2,3,4
256
257
258 return
259 end
260
261 *************************************************************************
262 subroutine readalignparam
263
264 include 'commontracker.f'
265 include 'common_mech.f'
266 include 'common_align.f'
267 include 'common_c2f.f'
268
269 character*50 fname_param
270 integer sensor
271 c character*120 cmd1
272 c character*120 cmd2
273
274 c2f_error = 0
275 call mech_sensor
276 do ip=1,nplanes
277 fitz(ip)=z_mech_sensor(ip,1,1)*0.1 !cm
278 * gets planes mechanical z positions
279 * (in mm) and sets them in micrometers
280 enddo
281
282
283 100 format('parameters_l',i1,'s',i1,'.dat')
284
285 do ilad=1,nladders_view
286 do is=1,2
287
288 write(fname_param,100)ilad,is
289 c if(C2F_DEBUG.eq.1)print *
290 if(VERBOSE)print *
291 $ ,c2f_path(1:c2f_pathlen)
292 $ //fname_param
293
294 open(10,
295 $ FILE=
296 $ c2f_path(1:c2f_pathlen)
297 $ //fname_param(1:LNBLNK(fname_param))
298 $ ,STATUS='OLD',IOSTAT=iostat
299 $ )
300 if(iostat.ne.0)then
301 c2f_error = 1
302 return
303 endif
304
305 do ip=1,nplanes
306 *
307 * NB! NB! NB! NB! NB!
308 * The file labelled for example "l1s1" include the alignment
309 * parameters of the column of sensors:
310 *
311 * PLANE LADDER SENSOR
312 * -------------------
313 * 1 1 2
314 * 2 1 1
315 * 3 1 1
316 * 4 1 1
317 * 5 1 1
318 * 6 1 1
319 *
320 * This is becouse the plane 1 (bottom plane) is up-side-down
321 *
322 sensor=is
323 if(ip.eq.1)sensor=mod(is,2)+1
324 read(10,*)omega(ip,ilad,sensor)
325 read(10,*)beta(ip,ilad,sensor)
326 read(10,*)gamma(ip,ilad,sensor)
327
328 c N.B. I convert angles from microradiants to radiant
329 omega(ip,ilad,sensor)=omega(ip,ilad,sensor)/1.d6
330 beta(ip,ilad,sensor)=beta(ip,ilad,sensor)/1.d6
331 gamma(ip,ilad,sensor)=gamma(ip,ilad,sensor)/1.d6
332
333 read(10,*)dx(ip,ilad,sensor)
334 read(10,*)dy(ip,ilad,sensor)
335 read(10,*)dz(ip,ilad,sensor)
336 enddo
337
338 close(10)
339 enddo
340 enddo
341
342 return
343 end
344
345 c------------------------------------------------------------------------
346
347 c NB: le coordinate in mech_pos.dat sono calcolate a partire da alcuni dati
348 c contenuti in commontracker.f. forse si puo' evitare mech_pos.dat e mettere
349 c tutto in commontracker.f
350
351
352 subroutine mech_sensor
353 c !it reads sensors coordinates (in PAMELA reference
354 c ! frame) from a text file and it uses them to fill
355 c ! x/y/z_mech_sensor variables, taking into account
356 c ! last plane inversion
357
358 include 'commontracker.f'
359 include 'common_tracks.f'
360 include 'common_c2f.f'
361
362 real xvec(nladders_view),yvec(2),zvec(nplanes)
363
364 c2f_error = 0
365
366 c if(C2F_DEBUG.eq.1)print *
367 if(VERBOSE)print *
368 $ ,c2f_path(1:c2f_pathlen)//'mech_pos.dat'
369 open(10
370 $ ,FILE=
371 $ c2f_path(1:c2f_pathlen)//'mech_pos.dat'
372 $ ,IOSTAT=iostat)
373 c !sensors centres coordinates in mm in
374 c ! PAMELA reference frame:
375 c ! the first plane is the one with lowest Z (the one
376 c ! nearest the calorimeter)
377 c ! the first ladder is the one with lowest X (the
378 c ! one on which the first X strip is)
379 c ! the first sensor is the one with lowest Y (the
380 c ! one on which the first Y strip is) for planes
381 c ! 2..6. for plane 1 the first sensor has higher Y
382
383 if(iostat.ne.0)then
384 c2f_error = 1
385 return
386 endif
387
388 read(10,*) xvec
389 read(10,*) yvec
390 read(10,*) zvec
391
392 do i=1,nplanes
393 do j=1,nladders_view
394 do k=1,2
395 x_mech_sensor(i,j,k)=xvec(j)
396 y_mech_sensor(i,j,k)=yvec(k)
397 z_mech_sensor(i,j,k)=zvec(i)
398 if(i.eq.1) then !y coordinates of first plane (11th view) are
399 y_mech_sensor(i,j,k)=-yvec(k) ! exchanged due to last plane inversion
400 endif
401 enddo
402 enddo
403 enddo
404
405 close(10)
406
407 ! *** INIZIO DEBUG ***
408 c$$$ do i=1,6
409 c$$$ do j=1,3
410 c$$$ do k=1,2
411 c$$$c j=1
412 c$$$ print*,x_mech_sensor(i,j,k)
413 c$$$ print*,y_mech_sensor(i,j,k)
414 c$$$ print*,z_mech_sensor(i,j,k)
415 c$$$ enddo
416 c$$$ enddo
417 c$$$ print*,' '
418 c$$$ enddo
419 ! *** FINE DEBUG ***
420
421
422 return
423 end
424 c------------------------------------------------------------------------
425

  ViewVC Help
Powered by ViewVC 1.1.23