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

Annotation of /yoda/techmodel/forroutines/calorimeter/calpulse.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: +174 -42 lines
*** empty log message ***

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

  ViewVC Help
Powered by ViewVC 1.1.23