/[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.6 - (show annotations) (download)
Mon Aug 20 15:58:24 2007 UTC (17 years, 3 months ago) by pam-fi
Branch: MAIN
Changes since 1.5: +33 -30 lines
*** empty log message ***

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.eq.1)print *
13 if(verbose.eq.1)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.eq.1)
22 if(debug.eq.1)
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.eq.1)
34 if(debug.eq.1)
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.eq.1)print *
60 if(VERBOSE.EQ.1)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.eq.1)print*
71 if(DEBUG.EQ.1)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.eq.1)print *
104 if(VERBOSE.EQ.1)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 * ======================================================
153 * read ANGULAR BINNING info
154 * ======================================================
155 fname_binning='binning.dat'
156 c if(C2F_DEBUG.EQ.1.eq.1)
157 if(VERBOSE.EQ.1)
158 $ print *
159 $ ,c2f_path(1:c2f_pathlen) !<<<< C2F
160 $ //fname_binning(1:LNBLNK(fname_binning))
161 open(10,
162 $ FILE=c2f_path(1:c2f_pathlen) !<<<< C2F
163 $ //fname_binning(1:LNBLNK(fname_binning))
164 $ ,STATUS='OLD'
165 $ ,IOSTAT=iostat
166 $ )
167 if(iostat.ne.0)then
168 c if(C2F_DEBUG.EQ.1.eq.1)
169 if(DEBUG.EQ.1)
170 $ print*,'READETAPARAM: *** Error in opening file *** '
171 c2f_error = 1
172 return
173 endif
174 c print*,'---- ANGULAR BINNING ----'
175 c print*,'Bin - angL - angR'
176 101 format(i2,' ',f6.2,' ',f6.2)
177 xnn=0
178 do ibin=1,nangmax
179 read(10,*
180 $ ,IOSTAT=iostat
181 $ )xnn,angL(ibin),angR(ibin)
182 if(iostat.ne.0)goto 1000
183 c write(*,101)int(xnn),angL(ibin),angR(ibin)
184 enddo
185 1000 nangbin=int(xnn)
186 close(10)
187 if(nangbin.eq.0)c2f_error = 1
188 c print*,'-------------------------'
189 c print*,nangbin
190
191
192
193 * ======================================================
194 * read eta2-eta3-eta4 parameters
195 * ======================================================
196 do ieta=2,4 !loop on eta 2,3,4
197 200 format(' Opening eta',i1,' files...')
198 c if(C2F_DEBUG.EQ.1.eq.1)write(*,200)ieta
199 if(VERBOSE.EQ.1)write(*,200)ieta
200
201 201 format('eta',i1,'-bin',i1,'-l',i1,'.dat')
202 202 format('eta',i1,'-bin',i2,'-l',i1,'.dat')
203 do iang=1,nangbin
204 do ilad=1,nladders_view
205
206 if(iang.lt.10)write(fname_param,201)ieta,iang,ilad
207 if(iang.ge.10)write(fname_param,202)ieta,iang,ilad
208 open(10,
209 c $ FILE=eta_parampath(1:eta_pathlen) !<<<< C2F
210 $ FILE=c2f_path(1:c2f_pathlen) !<<<< C2F
211 $ //fname_param(1:LNBLNK(fname_param))
212 $ ,STATUS='OLD'
213 $ ,IOSTAT=iostat
214 $ )
215 if(iostat.ne.0)then
216 c if(DEBUG.EQ.1)
217 if(.true.)
218 $ print*,'READETAPARAM: ** Error opening file ** '
219 $ ,c2f_path(1:c2f_pathlen)
220 $ //fname_param(1:LNBLNK(fname_param))
221 c2f_error = 1
222 c return
223 goto 2001
224 endif
225 netaval=0
226 do ival=1,netavalmax
227 if(ieta.eq.2)read(10,*
228 $ ,IOSTAT=iostat
229 $ )
230 $ eta2(ival,iang),
231 $ (feta2(ival,iv,ilad,iang),iv=1,nviews)
232 if(ieta.eq.3)read(10,*
233 $ ,IOSTAT=iostat
234 $ )
235 $ eta3(ival,iang),
236 $ (feta3(ival,iv,ilad,iang),iv=1,nviews)
237 if(ieta.eq.4)read(10,*
238 $ ,IOSTAT=iostat
239 $ )
240 $ eta4(ival,iang),
241 $ (feta4(ival,iv,ilad,iang),iv=1,nviews)
242 if(iostat.ne.0)then
243 if(netaval.eq.0)then
244 c if(C2F_DEBUG.EQ.1.eq.1)print*,'READETAPARAM: '
245 c if(DEBUG.EQ.1)
246 if(.true.)
247 $ print*,'READETAPARAM: '
248 $ //'*** Error reading file *** '
249 $ ,c2f_path(1:c2f_pathlen)
250 $ //fname_param(1:LNBLNK(fname_param))
251 $ ,' (netaval=',netaval,')'
252 c2f_error = 1
253 endif
254 goto 2000
255 endif
256 netaval=netaval+1
257 enddo
258 2000 close(10)
259 2001 continue
260 * print*,'... done'
261 enddo
262 enddo
263
264 enddo !end loop on eta 2,3,4
265
266 * ======================================================
267 * read landi correction
268 * ======================================================
269 if(VERBOSE.eq.1)print*,' Opening landi-correction files...'
270
271 301 format('lcorr-l',i1,'.dat')
272 do ilad=1,nladders_view
273
274 write(fname_param,301)ilad
275 open(10,
276 $ FILE=c2f_path(1:c2f_pathlen)
277 $ //fname_param(1:LNBLNK(fname_param))
278 $ ,STATUS='OLD'
279 $ ,IOSTAT=iostat
280 $ )
281 if(iostat.ne.0)then
282 if(.true.)
283 $ print*,'READETAPARAM: ** Error opening file ** '
284 $ ,c2f_path(1:c2f_pathlen)
285 $ //fname_param(1:LNBLNK(fname_param))
286 c c2f_error = 1 !tolto solo temporaneamente
287 c return
288 goto 3001
289 endif
290
291 do iang=1,nangbin
292
293 read(10,*,IOSTAT=iostat)
294 $ ii,aal,aar,(fcorr(iv,ilad,iang),iv=1,nviews)
295
296 c write(*,*)
297 c $ ii,aal,aar,(fcorr(iv,ilad,iang),iv=1,nviews)
298
299 if(ii.ne.iang)print*,'parametri eta incasinati'
300 if(aal.ne.angl(iang))print*,'parametri eta incasinati'
301 if(aar.ne.angr(iang))print*,'parametri eta incasinati'
302
303 if(iostat.ne.0)then
304 if(.true.)
305 $ print*,'READETAPARAM: '
306 $ //'*** Error reading file *** '
307 $ ,c2f_path(1:c2f_pathlen)
308 $ //fname_param(1:LNBLNK(fname_param))
309 c2f_error = 1
310 goto 3000
311 endif
312
313 enddo !end loop on angular bins
314 3000 close(10)
315 3001 continue
316
317 enddo ! end loop on ladders
318
319 return
320 end
321
322 *************************************************************************
323 subroutine readalignparam
324
325 include 'commontracker.f'
326 include 'common_mech.f'
327 include 'common_align.f'
328 include 'common_c2f.f'
329
330 character*50 fname_param
331 integer sensor
332 c character*120 cmd1
333 c character*120 cmd2
334
335 c2f_error = 0
336 call mech_sensor
337 do ip=1,nplanes
338 fitz(ip)=z_mech_sensor(ip,1,1)*0.1 !cm
339 * gets planes mechanical z positions
340 * (in mm) and sets them in micrometers
341 enddo
342
343
344 100 format('parameters_l',i1,'s',i1,'.dat')
345
346 do ilad=1,nladders_view
347 do is=1,2
348
349 write(fname_param,100)ilad,is
350 c if(C2F_DEBUG.EQ.1.eq.1)print *
351 if(VERBOSE.EQ.1)print *
352 $ ,c2f_path(1:c2f_pathlen)
353 $ //fname_param
354
355 open(10,
356 $ FILE=
357 $ c2f_path(1:c2f_pathlen)
358 $ //fname_param(1:LNBLNK(fname_param))
359 $ ,STATUS='OLD',IOSTAT=iostat
360 $ )
361 if(iostat.ne.0)then
362 c2f_error = 1
363 return
364 endif
365
366 do ip=1,nplanes
367 *
368 * NB! NB! NB! NB! NB!
369 * The file labelled for example "l1s1" include the alignment
370 * parameters of the column of sensors:
371 *
372 * PLANE LADDER SENSOR
373 * -------------------
374 * 1 1 2
375 * 2 1 1
376 * 3 1 1
377 * 4 1 1
378 * 5 1 1
379 * 6 1 1
380 *
381 * This is becouse the plane 1 (bottom plane) is up-side-down
382 *
383 sensor=is
384 if(ip.eq.1)sensor=mod(is,2)+1
385 read(10,*)omega(ip,ilad,sensor)
386 read(10,*)beta(ip,ilad,sensor)
387 read(10,*)gamma(ip,ilad,sensor)
388
389 c N.B. I convert angles from microradiants to radiant
390 omega(ip,ilad,sensor)=omega(ip,ilad,sensor)/1.d6
391 beta(ip,ilad,sensor)=beta(ip,ilad,sensor)/1.d6
392 gamma(ip,ilad,sensor)=gamma(ip,ilad,sensor)/1.d6
393
394 read(10,*)dx(ip,ilad,sensor)
395 read(10,*)dy(ip,ilad,sensor)
396 read(10,*)dz(ip,ilad,sensor)
397 enddo
398
399 close(10)
400 enddo
401 enddo
402
403 return
404 end
405
406 c------------------------------------------------------------------------
407
408 c NB: le coordinate in mech_pos.dat sono calcolate a partire da alcuni dati
409 c contenuti in commontracker.f. forse si puo' evitare mech_pos.dat e mettere
410 c tutto in commontracker.f
411
412
413 subroutine mech_sensor
414 c !it reads sensors coordinates (in PAMELA reference
415 c ! frame) from a text file and it uses them to fill
416 c ! x/y/z_mech_sensor variables, taking into account
417 c ! last plane inversion
418
419 include 'commontracker.f'
420 include 'common_tracks.f'
421 include 'common_c2f.f'
422
423 real xvec(nladders_view),yvec(2),zvec(nplanes)
424
425 c2f_error = 0
426
427 c if(C2F_DEBUG.EQ.1.eq.1)print *
428 if(VERBOSE.EQ.1)print *
429 $ ,c2f_path(1:c2f_pathlen)//'mech_pos.dat'
430 open(10
431 $ ,FILE=
432 $ c2f_path(1:c2f_pathlen)//'mech_pos.dat'
433 $ ,IOSTAT=iostat)
434 c !sensors centres coordinates in mm in
435 c ! PAMELA reference frame:
436 c ! the first plane is the one with lowest Z (the one
437 c ! nearest the calorimeter)
438 c ! the first ladder is the one with lowest X (the
439 c ! one on which the first X strip is)
440 c ! the first sensor is the one with lowest Y (the
441 c ! one on which the first Y strip is) for planes
442 c ! 2..6. for plane 1 the first sensor has higher Y
443
444 if(iostat.ne.0)then
445 c2f_error = 1
446 return
447 endif
448
449 read(10,*) xvec
450 read(10,*) yvec
451 read(10,*) zvec
452
453 do i=1,nplanes
454 do j=1,nladders_view
455 do k=1,2
456 x_mech_sensor(i,j,k)=xvec(j)
457 y_mech_sensor(i,j,k)=yvec(k)
458 z_mech_sensor(i,j,k)=zvec(i)
459 if(i.eq.1) then !y coordinates of first plane (11th view) are
460 y_mech_sensor(i,j,k)=-yvec(k) ! exchanged due to last plane inversion
461 endif
462 enddo
463 enddo
464 enddo
465
466 close(10)
467
468 ! *** INIZIO DEBUG ***
469 c$$$ do i=1,6
470 c$$$ do j=1,3
471 c$$$ do k=1,2
472 c$$$c j=1
473 c$$$ print*,x_mech_sensor(i,j,k)
474 c$$$ print*,y_mech_sensor(i,j,k)
475 c$$$ print*,z_mech_sensor(i,j,k)
476 c$$$ enddo
477 c$$$ enddo
478 c$$$ print*,' '
479 c$$$ enddo
480 ! *** FINE DEBUG ***
481
482
483 return
484 end
485 c------------------------------------------------------------------------
486

  ViewVC Help
Powered by ViewVC 1.1.23