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

Contents of /DarthVader/TrackerLevel2/src/F77/fillpedsig.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, v1r01beta, v1r00, v1r01
Changes since 1.1: +105 -1 lines
Error handling from F77 routine / Fixed some bugs with default calibration

1 subroutine fillpedsigfromdefault()
2
3 include 'commontracker.f'
4 include 'calib.f'
5 include 'common_c2f.f' !<<<< C2F
6
7 integer dsp(2,6)
8 character*60 fname_param
9
10 c2f_error = 0
11
12 fname_param='cabling.dat'
13 c if(DEBUG)print *
14 c $ ,c2f_path(1:c2f_pathlen) !<<<< C2F
15 c $ //fname_param(1:LNBLNK(fname_param))
16 open(10,
17 $ FILE=c2f_path(1:c2f_pathlen) !<<<< C2F
18 $ //fname_param(1:LNBLNK(fname_param))
19 $ ,STATUS='OLD'
20 $ ,IOSTAT=iostat
21 $ )
22 if(iostat.ne.0)then
23 c if(C2F_DEBUG.eq.1)print*
24 if(DEBUG)print*
25 $ ,'READPEDSIGFROMDEFAULT: *** Error opening file *** '
26 c2f_error = 1
27 return
28 endif
29 do iv=1,nviews
30 read(10,*
31 $ ,IOSTAT=iostat
32 $ )ilink,ipn,dsp(ilink,ipn+1)
33 if(iostat.ne.0)then
34 c2f_error = 1
35 goto 100
36 endif
37 enddo
38 100 close(10)
39
40 300 format('link',i1,'/param2_',i1,'_',i1,'.dat')
41 do ilink=1,2 !loop over links
42 if(VERBOSE)print *,'Opening default calibration - link'
43 $ ,ilink
44 do ipn=0,5 !loop over peripheral numbers
45 do iladder=1,3 !loop over DSP
46 write(fname_param,300)ilink,ipn,iladder
47 c if(DEBUG)print*,
48 c $ ,c2f_path(1:c2f_pathlen) !<<<< C2F
49 c $ //fname_param(1:LNBLNK(fname_param))
50 open(10,
51 $ FILE=c2f_path(1:c2f_pathlen) !<<<< C2F
52 $ //fname_param(1:LNBLNK(fname_param))
53 $ ,STATUS='OLD'
54 $ ,IOSTAT=iostat
55 $ )
56 if(iostat.ne.0)then
57 c if(C2F_DEBUG.eq.1)print*
58 if(DEBUG)print*
59 $ ,'READPEDSIGFROMDEFAULT:'
60 $ ,' *** Error opening file *** '
61 c2f_error = 1
62 return
63 endif
64 * PEDESTAL ----------------------
65 do is=1,nstrips_ladder
66 read(10,*
67 $ ,IOSTAT=iostat)
68 $ pedestal_t( dsp(ilink,ipn+1)
69 $ ,(nvk(is)+(iladder-1)*nva1_ladder)
70 $ ,nst(is))
71 c print*,ilink,ipn,is,' --- ',dsp(ilink,ipn+1)
72 c $ ,(nvk(is)+(iladder-1)*nva1_ladder)
73 c $ ,nst(is)
74 if(iostat.ne.0)then
75 c2f_error = 1
76 print*,'ped ',is
77 goto 1000
78 endif
79 enddo
80 * SIGMA -------------------------
81 do is=1,nstrips_ladder
82 read(10,*
83 $ ,IOSTAT=iostat)
84 $ sigma_t(
85 $ dsp(ilink,ipn+1)
86 $ ,(nvk(is)+(iladder-1)*nva1_ladder)
87 $ ,nst(is))
88 if(iostat.ne.0)then
89 c2f_error = 1
90 print*,'sig ',is
91 goto 1000
92 endif
93 enddo
94 * -------------------------------
95
96 1000 close(10)
97
98 enddo !end loop over DSP
99 enddo !end loop over peripheral numbers
100 enddo !end loop over links
101 return
102 end
103
104
105 *************************************************************************
106 *
107 * Subroutine fillpedsig.f
108 *
109 * - fills bad, pedestal and sigma variables with respective values from
110 * level0 histograms, in order to perform cluster identification !???
111 * - fills bad, pedestal_t and sigma_t variables with respective truncated
112 * values from level0 histograms, in order to perform data decompression
113 *
114 * needs:
115 * - level0 pedestal, sigma and badstrip histograms
116 *
117 * output variables:
118 * - bad
119 * - pedestal
120 * - pedestal_t
121 * - sigma
122 * - sigma_t
123 *
124 * to be called inside ./reduction.f
125 *
126 *************************************************************************
127
128
129 subroutine fillpedsigfromdefaultrz()
130
131 include 'commontracker.f'
132 include 'common_reduction.f'
133 include 'common_c2f.f'
134 include 'calib.f'
135
136 external nvk
137 external nst
138
139 c------------------------------------------------------------------------
140 c
141 c local variables
142 c
143 c------------------------------------------------------------------------
144
145 REAL hmemor(10000000)
146 integer Iquest(100)
147 COMMON /pawc/hmemor
148 save /pawc/
149 C
150 Common /QUEST/ Iquest
151 save /quest/
152
153 real content(nstrips_view) !temporary array
154 parameter (lun_data_file=70) !data file id number
155
156 c character*60 fname_param
157
158
159 CALL HLIMIT(10000000)
160
161 IQUEST(10)=65000
162
163 c2f_error=0
164
165
166 if(C2F_DEBUG.eq.1)print*,c2f_path(1:c2f_pathlen)
167 call HROPEN(lun_data_file,
168 $ 'CALIB'
169 $ ,c2f_path(1:c2f_pathlen) !<<<< C2F
170 $ ,'QP',4096,istat) !opens
171 if(istat.ne.0)then
172 c2f_error=1
173 goto 19
174 endif
175 call HRIN(0,9999,0)
176
177
178 c------------------------------------------------------------------------
179 c
180 c loops on views filling badstrip, pedestal and sigma variables from
181 c level0 histograms
182 c
183 c------------------------------------------------------------------------
184
185 do iv=1,nviews
186 call HUNPAK(id_hi_bad+iv,content,' ',0) !puts histo contents in an array
187 do is=1,nstrips_view !fills variables with array values
188 bad(iv,nvk(is),nst(is))=INT(content(is))
189 enddo
190
191 call HUNPAK(id_hi_ped+iv,content,' ',0)
192 do is=1,nstrips_view
193 pedestal(iv,nvk(is),nst(is))=content(is)
194 cc print*,'ped',pedestal(iv,nvk(is),nst(is))
195 pedestal_t(iv,nvk(is),nst(is))=AINT(content(is)) !truncated value
196 cc print*,'ped_t',pedestal_t(iv,nvk(is),nst(is))
197 enddo
198
199 call HUNPAK(id_hi_sig+iv,content,' ',0)
200 do is=1,nstrips_view
201 sigma(iv,nvk(is),nst(is))=content(is)
202 sigma_t(iv,nvk(is),nst(is))=ANINT(content(is)) !truncated value
203 enddo
204
205 do is=1,nstrips_view!inversione (a volte ritornano, quasi...) badstrip!???
206 if(bad(iv,nvk(is),nst(is)).eq.1) then
207 bad(iv,nvk(is),nst(is))=0
208 else
209 bad(iv,nvk(is),nst(is))=1
210 endif
211 enddo
212
213 enddo
214
215 do iview=1,nviews
216 call HDELET(id_hi_bad+iview)
217 call HDELET(id_hi_ped+iview)
218 call HDELET(id_hi_sig+iview)
219 enddo
220 call HREND('CALIB')
221 close(lun_data_file)
222
223
224
225 c$$$ C
226 c$$$ C inversione vista 11: devo riinvertire i valori contenuti negli istogrammi
227 c$$$ C per poter decomprimere i dati compressi (che sono stati messi a diritto
228 c$$$ C nel vettore datatracker, senza inversione 11). quello che mi serve e' di
229 c$$$ C riinvertire pedestal_t(11,nvk(is),nst(is)) e (anche se forse non lo uso)
230 c$$$ C sigma_t(11,nvk(is),nst(is)) !???
231 c$$$ C
232 c$$$ do is=1,nstrips_view
233 c$$$ content(is) = pedestal_t(11,nvk(is),nst(is))
234 c$$$ enddo
235 c$$$
236 c$$$ do is=1,nstrips_view
237 c$$$ offset=5121
238 c$$$ if(is.le.2048) offset=3073
239 c$$$ if(is.le.1024) offset=1025
240 c$$$ iss=offset-is
241 c$$$
242 c$$$ pedestal_t(11,nvk(iss),nst(iss)) = content(is)
243 c$$$ enddo
244 c$$$
245 c$$$
246 c$$$ do is=1,nstrips_view
247 c$$$ content(is) = sigma_t(11,nvk(is),nst(is))
248 c$$$ enddo
249 c$$$
250 c$$$ do is=1,nstrips_view
251 c$$$ offset=5121
252 c$$$ if(is.le.2048) offset=3073
253 c$$$ if(is.le.1024) offset=1025
254 c$$$ iss=offset-is
255 c$$$
256 c$$$ sigma_t(11,nvk(iss),nst(iss)) = content(is)
257 c$$$ enddo
258 c$$$ C
259 c$$$ C fine inversione vista 11 !???
260 c$$$ C
261 19 continue
262 return
263 end

  ViewVC Help
Powered by ViewVC 1.1.23