/[PAMELA software]/yoda/techmodel/forroutines/calorimeter/calpedestal.for
ViewVC logotype

Annotation of /yoda/techmodel/forroutines/calorimeter/calpedestal.for

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.6 - (hide annotations) (download)
Sat Jul 17 20:03:44 2004 UTC (20 years, 5 months ago) by kusanagi
Branch: MAIN
Changes since 1.5: +209 -63 lines
*** empty log message ***

1 kusanagi 1.3 C------------------------------------------------
2     C SUBROUTINE CALPEDESTAL(vect,ERROR,calped,calgood,calthr,
3     C & calrms,calbase,calvar,contr,e2)
4 kusanagi 1.6 SUBROUTINE CALPEDESTAL(vecta,lung,me)
5 kusanagi 1.3 C------------------------------------------------
6    
7     IMPLICIT NONE
8     C
9     C Normal variables definition
10     C
11     INTEGER ERROR(4)
12     C
13     integer lung, me
14     INTEGER i, j, ival, iev
15     INTEGER NPLA, NCHA, LENSEV
16     PARAMETER (NPLA=22,NCHA=96,LENSEV=NPLA*NCHA)
17     C
18     INTEGER*2 VECT(20000)
19 kusanagi 1.6 INTEGER*1 VECTA(40000)
20 kusanagi 1.3 C
21     integer*2 check, crc, e2(4)
22     C
23     INTEGER ic, k, ke, ic0
24 kusanagi 1.6 INTEGER status,contr,m
25 kusanagi 1.3 INTEGER inf, sup,iev2
26     INTEGER XO, YO, XE, YE
27    
28     INTEGER*2 length, length2
29 kusanagi 1.6 integer st1b, st2b,p,bit,bi,icb
30 kusanagi 1.3 INTEGER st1, st3
31     INTEGER st2
32    
33     REAL calped(4,11,96), calgood(4,11,96), calthr(4,11,6)
34     REAL calrms(4,11,96), calbase(4,11,6), calvar(4,11,6)
35    
36     DATA XO/177/ ! CODE_DSP_R XO = 101 10001
37     DATA YO/173/ ! CODE_DSP_R YO = 101 01101
38     DATA XE/170/ ! CODE_DSP_R XE = 101 01010
39     DATA YE/182/ ! CODE_DSP_R YE = 101 10110
40    
41     REAL calpuls(4,11,96)
42     real calselftrig(4,7), calIItrig(4), calstripshit(4)
43     real calDSPtaberr(4), calevnum(4)
44 kusanagi 1.6 REAL DEXY(2,NPLA,NCHA), dexyc(2,npla,ncha), base(2,npla,6)
45 kusanagi 1.3
46     COMMON / evento / IEV,
47     & dexy,dexyc,base,
48     & calselftrig,calIItrig,
49     & calstripshit,calDSPtaberr,calevnum
50    
51     save / evento /
52    
53     COMMON / calib / IEV2, calped, calgood, calthr, calrms,
54     & calbase,
55     & calvar,
56     & calpuls
57    
58     save / calib /
59    
60     COMMON /VARIE/error, CONTR, E2
61     SAVE /VARIE/
62    
63    
64     C
65     C Begin !
66     C
67     ival = 0
68     C
69     me = 0
70     ic = 0
71     c
72     length = ic
73     c
74     20 CONTINUE
75 kusanagi 1.6 ic = ic + length + 1
76 kusanagi 1.5 32 continue
77 kusanagi 1.3 ke = 0
78     do while (ke.eq.0)
79     C
80     C Check consistency of header.
81     C it is composed by CODE+D# (8 bits) and by SATUS WORD (8 bits)
82     c so we must split vect into the two components:
83     C
84     C ST1 is CODE + D#
85 kusanagi 1.6 c
86     st1b = 0
87     st2b = 0
88     do bit = 0, 7
89     bi = ibits(vecta(ic),bit,1)
90     if (bi.eq.1) st1b = ibset(st1b,bit)
91     bi = ibits(vecta(ic+1),bit,1)
92     if (bi.eq.1) st2b = ibset(st2b,bit)
93     enddo
94     c
95 kusanagi 1.3 C ST2 is the STATUS WORD
96 kusanagi 1.6 c
97     length2 = 0
98     do bit=0, 7
99     bi = ibits(vecta(ic+3),bit,1)
100     if (bi.eq.1) length2 = ibset(length2,bit)
101     bi = ibits(vecta(ic+2),bit,1)
102     if (bi.eq.1) length2 = ibset(length2,bit+8)
103     enddo
104     c the crc should be at vect(length) with
105     length = length2 + 1
106     C
107     c some checks to be sure we have found the calorimeter data:
108     c
109     c status word is always less then 129
110     c
111     if (st2b.gt.128) then
112     length = 0
113     goto 100
114     endif
115     c
116     c length of the packet must be less then 20000 if no errors
117     c are found
118     c
119     if (st2b.eq.0.and.length2.gt.20000) then
120     length = 0
121     goto 100
122     endif
123     c
124     if (length2.le.0) then
125     length = 0
126     goto 100
127     endif
128 kusanagi 1.3 c
129     e2(contr) = 0
130     C
131     if (contr.eq.1) then
132 kusanagi 1.6 c
133     c is it the first section?
134     c
135     if (st1b.eq.YE) then
136     c if so go out of this loop and go on recording data
137 kusanagi 1.3 ke = 1
138 kusanagi 1.6 m = ic
139     do i = 1, 20000
140     vect(i) = 0
141     do bit=0, 7
142     bi = ibits(vecta(m+1),bit,1)
143     if (bi.eq.1) vect(i) = ibset(vect(i),bit)
144     bi = ibits(vecta(m),bit,1)
145     if (bi.eq.1) vect(i) = ibset(vect(i),bit+8)
146     enddo
147     m = m + 2
148     enddo
149     icb = 1
150     if (st2b.ne.0) then
151     E2(contr) = vect(icb)
152 kusanagi 1.3 endif
153 kusanagi 1.6 goto 9
154 kusanagi 1.3 else
155 kusanagi 1.6 c if not, is it one of the next sections? did we miss a section?
156     if (st1b.eq.YO.or.st1b.eq.XE.or.st1b.eq.XO) THEN
157     c if so, record an error and go back analizing this section
158     error(contr) = 129
159     contr = 2
160     goto 32
161 kusanagi 1.3 ELSE
162 kusanagi 1.6 c if it is not the case, go on with the next value of vect
163     ERROR(contr) = 128
164 kusanagi 1.3 GOTO 100
165     endif
166     endif
167     ENDIF
168     C
169 kusanagi 1.6 c the same for the second section, ...
170     c
171     if (CONTR.eq.2) then
172     if (st1b.eq.YO) then
173 kusanagi 1.3 ke = 1
174 kusanagi 1.6 m = ic
175     do i = 1, 20000
176     vect(i) = 0
177     do bit=0, 7
178     bi = ibits(vecta(m+1),bit,1)
179     if (bi.eq.1) vect(i) = ibset(vect(i),bit)
180     bi = ibits(vecta(m),bit,1)
181     if (bi.eq.1) vect(i) = ibset(vect(i),bit+8)
182     enddo
183     m = m + 2
184     enddo
185     icb = 1
186     if (st2b.ne.0) then
187     E2(contr) = vect(icb)
188 kusanagi 1.3 endif
189 kusanagi 1.6 goto 9
190 kusanagi 1.3 else
191 kusanagi 1.6 if (st1b.eq.XE.or.st1b.eq.XO) then
192 kusanagi 1.3 error(contr) = 129
193     contr = 3
194 kusanagi 1.5 goto 32
195 kusanagi 1.3 ELSE
196     ERROR(contr) = 128
197     GOTO 100
198     endif
199     endif
200     ENDIF
201 kusanagi 1.6 c
202     C ... for the third,...
203     c
204 kusanagi 1.3 if (CONTR.eq.3) then
205 kusanagi 1.6 if (st1b.eq.XE) then
206 kusanagi 1.3 ke = 1
207 kusanagi 1.6 m = ic
208     do i = 1, 20000
209     vect(i) = 0
210     do bit=0, 7
211     bi = ibits(vecta(m+1),bit,1)
212     if (bi.eq.1) vect(i) = ibset(vect(i),bit)
213     bi = ibits(vecta(m),bit,1)
214     if (bi.eq.1) vect(i) = ibset(vect(i),bit+8)
215     enddo
216     m = m + 2
217     enddo
218     icb = 1
219     if (st2b.ne.0) then
220     E2(contr) = vect(icb)
221 kusanagi 1.3 endif
222 kusanagi 1.6 goto 9
223 kusanagi 1.3 else
224 kusanagi 1.6 if (st1b.eq.XO) then
225 kusanagi 1.3 error(contr) = 129
226     contr = 4
227 kusanagi 1.5 goto 32
228 kusanagi 1.3 ELSE
229 kusanagi 1.6 ERROR(contr) = 128
230 kusanagi 1.3 GOTO 100
231     endif
232     endif
233     ENDIF
234     C
235 kusanagi 1.6 c ...and for the last section.
236     c
237 kusanagi 1.3 if (CONTR.eq.4) then
238 kusanagi 1.6 if (st1b.eq.XO) then
239 kusanagi 1.3 ke = 1
240 kusanagi 1.6 m = ic
241     do i = 1, 20000
242     vect(i) = 0
243     do bit=0, 7
244     bi = ibits(vecta(m+1),bit,1)
245     if (bi.eq.1) vect(i) = ibset(vect(i),bit)
246     bi = ibits(vecta(m),bit,1)
247     if (bi.eq.1) vect(i) = ibset(vect(i),bit+8)
248     enddo
249     m = m + 2
250     enddo
251     icb = 1
252     if (st2b.ne.0) then
253     E2(contr) = vect(icb)
254 kusanagi 1.3 endif
255     else
256 kusanagi 1.6 c we should never arrive here (in case we run out of vector if section
257     c four is missing!)... however here it is in case of bugs!
258     c
259 kusanagi 1.3 ERROR(contr) = 128
260 kusanagi 1.6 goto 100
261 kusanagi 1.3 endif
262     endif
263     C
264     100 CONTINUE
265 kusanagi 1.6 c
266     c increment vector of one searching for the next section
267     c
268     9 continue
269 kusanagi 1.3 ic = ic + 1
270 kusanagi 1.6 c
271     c if we run out of vector give an error and exit the subroutine
272     c
273     if (ic.gt.39999) then
274     error(contr) = 130
275 kusanagi 1.3 if (contr.ne.1) contr=5
276     me = 1
277     goto 200
278     endif
279     enddo
280     C
281     10 FORMAT(2X,'Error for view:',2X,I1,2X,'Status word:',2X,Z4)
282     11 FORMAT(2X,'View or command not recognized for view:',2X,I1,2X,
283     & 'Status word:',2X,Z4)
284     12 FORMAT(2X,'Error - did NOT find view:',2X,I1)
285     13 FORMAT(2X,'Error - eov reached, exiting')
286     101 FORMAT(2X,'Status word 1:',2X,Z8)
287     201 FORMAT(2X,'Status word 2:',2X,Z8)
288     C
289     K = CONTR
290 kusanagi 1.6 ic0 = icb
291     ic = ic - 1
292     icb = icb + 1
293     length = vect(icb) + 2
294     length2 = vect(icb)
295 kusanagi 1.3 C
296     C Check validity of length.
297     C
298 kusanagi 1.6 if (vect(icb).ne.4629) then
299 kusanagi 1.3 ERROR(contr) = 131
300     me = 1
301     goto 200
302     endif
303     C
304     C Check consistency of CRC.
305     C
306     check = 0.
307     inf = ic0
308     sup = length - 1
309     do i = inf,sup
310     check=crc(check,vect(i))
311     enddo
312     if (check.ne.vect(length)) then
313     ERROR(contr) = 132
314     me = 1
315     goto 200
316     endif
317     C
318     C Process data.
319     C
320 kusanagi 1.6 if (k.eq.1) then
321     k = 4
322     goto 49
323     endif
324     if (k.eq.2) then
325     k = 2
326     goto 49
327     endif
328     if (k.eq.3) then
329     k = 1
330     goto 49
331     endif
332     if (k.eq.4) k = 3
333     c
334     49 continue
335     c
336 kusanagi 1.3 do i = 1,11
337     do j = 1,96
338 kusanagi 1.6 icb = icb + 1
339     if (k.eq.1) then
340     calped(k,i,97-j) = vect(icb)
341     calgood(k,i,97-j) = vect(icb+1)
342     else
343     calped(k,i,j) = vect(icb)
344     calgood(k,i,j) = vect(icb+1)
345     endif
346     icb = icb + 1
347 kusanagi 1.3 enddo
348     enddo
349     C
350 kusanagi 1.6 icb = icb + 4
351 kusanagi 1.3 do i = 1,11
352     do j = 1,6
353 kusanagi 1.6 icb = icb + 1
354     if (k.eq.1) then
355     calthr(k,i,7-j) = vect(icb)
356     else
357     calthr(k,i,j) = vect(icb)
358     endif
359     icb = icb + 1
360 kusanagi 1.3 enddo
361     enddo
362     c
363 kusanagi 1.6 icb = icb + 4
364 kusanagi 1.3 do i = 1,11
365     do j = 1,96
366 kusanagi 1.6 icb = icb + 1
367     if (k.eq.1) then
368     calrms(k,i,97-j) = vect(icb)
369     else
370     calrms(k,i,j) = vect(icb)
371     endif
372     icb = icb + 1
373 kusanagi 1.3 enddo
374     enddo
375 kusanagi 1.6 c
376 kusanagi 1.3 do i = 1,11
377     do j = 1,6
378 kusanagi 1.6 icb = icb + 1
379     if (k.eq.1) then
380     calbase(k,i,7-j) = vect(icb)
381     icb = icb + 1
382     icb = icb + 1
383     calvar(k,i,7-j) = vect(icb)
384     icb = icb + 1
385     else
386     calbase(k,i,j) = vect(icb)
387     icb = icb + 1
388     icb = icb + 1
389     calvar(k,i,j) = vect(icb)
390     icb = icb + 1
391     endif
392 kusanagi 1.3 enddo
393     enddo
394     CONTR = CONTR + 1
395     me = 0
396     c
397     if (contr.eq.5) contr = 1
398     c
399     50 continue
400     C
401     200 continue
402     if (error(1).eq.129.and.error(2).eq.129
403     & .and.error(3).eq.129.and.error(4).eq.130) then
404 kusanagi 1.5 call azero(error,4)
405 kusanagi 1.3 contr=1
406     me = 1
407     endif
408     C
409     RETURN
410     END
411    
412    

  ViewVC Help
Powered by ViewVC 1.1.23