/[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.4 - (show annotations) (download)
Mon Aug 20 16:07:16 2007 UTC (17 years, 3 months ago) by pam-fi
Branch: MAIN
CVS Tags: v5r00, v4r00, v10RED, v9r00, v9r01, v10REDr01, v6r01, v6r00, HEAD
Changes since 1.3: +8 -8 lines
missing-image bug fixed + other changes

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.EQ.1)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.eq.1)print*
24 if(DEBUG.EQ.1)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.EQ.1)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.EQ.1)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.eq.1)print*
58 if(DEBUG.EQ.1)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 'level1.f'
133 include 'common_reduction.f'
134 include 'common_c2f.f'
135 include 'calib.f'
136
137 external nvk
138 external nst
139
140 c------------------------------------------------------------------------
141 c
142 c local variables
143 c
144 c------------------------------------------------------------------------
145
146 REAL hmemor(10000000)
147 integer Iquest(100)
148 COMMON /pawc/hmemor
149 save /pawc/
150 C
151 Common /QUEST/ Iquest
152 save /quest/
153
154 real content(nstrips_view) !temporary array
155 parameter (lun_data_file=70) !data file id number
156
157 c character*60 fname_param
158
159
160 CALL HLIMIT(10000000)
161
162 IQUEST(10)=65000
163
164 c2f_error=0
165
166
167 if(DEBUG.eq.1)print*,c2f_path(1:c2f_pathlen)
168 call HROPEN(lun_data_file,
169 $ 'CALIB'
170 $ ,c2f_path(1:c2f_pathlen) !<<<< C2F
171 $ ,'QP',4096,istat) !opens
172 if(istat.ne.0)then
173 c2f_error=1
174 goto 19
175 endif
176 call HRIN(0,9999,0)
177
178
179 c------------------------------------------------------------------------
180 c
181 c loops on views filling badstrip, pedestal and sigma variables from
182 c level0 histograms
183 c
184 c------------------------------------------------------------------------
185
186 do iv=1,nviews
187 call HUNPAK(id_hi_bad+iv,content,' ',0) !puts histo contents in an array
188 do is=1,nstrips_view !fills variables with array values
189 bad(iv,nvk(is),nst(is))=INT(content(is))
190 enddo
191
192 call HUNPAK(id_hi_ped+iv,content,' ',0)
193 do is=1,nstrips_view
194 pedestal(iv,nvk(is),nst(is))=content(is)
195 cc print*,'ped',pedestal(iv,nvk(is),nst(is))
196 pedestal_t(iv,nvk(is),nst(is))=AINT(content(is)) !truncated value
197 cc print*,'ped_t',pedestal_t(iv,nvk(is),nst(is))
198 enddo
199
200 call HUNPAK(id_hi_sig+iv,content,' ',0)
201 do is=1,nstrips_view
202 sigma(iv,nvk(is),nst(is))=content(is)
203 sigma_t(iv,nvk(is),nst(is))=ANINT(content(is)) !truncated value
204 enddo
205
206 do is=1,nstrips_view!inversione (a volte ritornano, quasi...) badstrip!???
207 if(bad(iv,nvk(is),nst(is)).eq.1) then
208 bad(iv,nvk(is),nst(is))=0
209 else
210 bad(iv,nvk(is),nst(is))=1
211 endif
212 enddo
213
214 enddo
215
216 do iview=1,nviews
217 call HDELET(id_hi_bad+iview)
218 call HDELET(id_hi_ped+iview)
219 call HDELET(id_hi_sig+iview)
220 enddo
221 call HREND('CALIB')
222 close(lun_data_file)
223
224
225
226 c$$$ C
227 c$$$ C inversione vista 11: devo riinvertire i valori contenuti negli istogrammi
228 c$$$ C per poter decomprimere i dati compressi (che sono stati messi a diritto
229 c$$$ C nel vettore datatracker, senza inversione 11). quello che mi serve e' di
230 c$$$ C riinvertire pedestal_t(11,nvk(is),nst(is)) e (anche se forse non lo uso)
231 c$$$ C sigma_t(11,nvk(is),nst(is)) !???
232 c$$$ C
233 c$$$ do is=1,nstrips_view
234 c$$$ content(is) = pedestal_t(11,nvk(is),nst(is))
235 c$$$ enddo
236 c$$$
237 c$$$ do is=1,nstrips_view
238 c$$$ offset=5121
239 c$$$ if(is.le.2048) offset=3073
240 c$$$ if(is.le.1024) offset=1025
241 c$$$ iss=offset-is
242 c$$$
243 c$$$ pedestal_t(11,nvk(iss),nst(iss)) = content(is)
244 c$$$ enddo
245 c$$$
246 c$$$
247 c$$$ do is=1,nstrips_view
248 c$$$ content(is) = sigma_t(11,nvk(is),nst(is))
249 c$$$ enddo
250 c$$$
251 c$$$ do is=1,nstrips_view
252 c$$$ offset=5121
253 c$$$ if(is.le.2048) offset=3073
254 c$$$ if(is.le.1024) offset=1025
255 c$$$ iss=offset-is
256 c$$$
257 c$$$ sigma_t(11,nvk(iss),nst(iss)) = content(is)
258 c$$$ enddo
259 c$$$ C
260 c$$$ C fine inversione vista 11 !???
261 c$$$ C
262 19 continue
263 return
264 end

  ViewVC Help
Powered by ViewVC 1.1.23