/[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 4.4 - (hide annotations) (download)
Sat May 28 10:44:12 2005 UTC (19 years, 6 months ago) by kusanagi
Branch: MAIN
Changes since 4.1: +0 -0 lines
Main features of this release are:
- updated classes documentations;
- major changes on the calibration fortran routine for the calorimeter
- update on the TMTC thermistors
- removed old classes as CalibTrkBoth and CalibTrd

1 kusanagi 1.7 C
2     C Written by Mirko Boezio and Emiliano Mocchiutti
3     C
4 kusanagi 4.1 C * Version: 3.1.4 *
5     C
6     C 3.1.3 - 3.1.4: (2005-05-26) the decoding is wrong!!! we are reading all strip in one plane per time and not one strip over all planes per time!!!!
7 kusanagi 2.6 C
8     C 3.1.2 - 3.1.3: (2005-02-23) added some printout in debugging mode.
9 kusanagi 2.5 C
10     C 3.1.1 - 3.1.2: (2004-12-21) changed common varie.
11 kusanagi 2.4 C
12     C 3.1.0 - 3.1.1: (2004-12-13) bug in filling the calpuls vector. Fixed.
13     C
14     C 3.0.0 - 3.1.0: (2004-12-10) changes in the sections order and increment
15     C iev each time calpulse is called. Cleanup of the code.
16 kusanagi 2.3 C
17     C 0.00.0 - 3.0.0: (2004-11-08) changes in the commons (one more common for
18     C calpulse and from calstripshit to calstriphit).
19 kusanagi 1.7 C
20 kusanagi 1.9 C - fixed compilation error
21     C
22 kusanagi 1.3 C------------------------------------------------
23 kusanagi 1.6 SUBROUTINE CALPULSE(vecta,lung,me)
24 kusanagi 1.3 C------------------------------------------------
25    
26     IMPLICIT NONE
27     C
28     C Normal variables definition
29     C
30 kusanagi 2.4 INTEGER i, j, lung, me
31 kusanagi 1.3 INTEGER NPLA, NCHA, LENSEV
32     PARAMETER (NPLA=22,NCHA=96,LENSEV=NPLA*NCHA)
33     C
34 kusanagi 1.8 INTEGER*2 VECT(60000)
35 kusanagi 1.7 INTEGER*1 VECTA(lung)
36 kusanagi 1.3 integer*2 check, crc,e2(4)
37 kusanagi 2.4 INTEGER*2 length, length2
38 kusanagi 1.3 C
39 kusanagi 2.5 INTEGER ERROR(4), merror(4)
40 kusanagi 1.3 INTEGER ic, k, ke, ic0
41 kusanagi 2.4 INTEGER CONTR, m
42 kusanagi 1.7 INTEGER inf, sup, lunga,lleng,l
43 kusanagi 1.3 INTEGER XO, YO, XE, YE
44 kusanagi 2.4 integer pstwerr(4), IEV
45     integer dump
46     integer st1b, st2b, bit,bi,icb, pari
47 kusanagi 1.3
48 kusanagi 2.4 real pperror(4)
49 kusanagi 1.3 REAL calpuls(4,11,96)
50    
51     DATA XO/177/ ! CODE_DSP_R XO = 101 10001
52     DATA YO/173/ ! CODE_DSP_R YO = 101 01101
53     DATA XE/170/ ! CODE_DSP_R XE = 101 01010
54     DATA YE/182/ ! CODE_DSP_R YE = 101 10110
55    
56 kusanagi 2.4 COMMON / calpul / iev, pstwerr, pperror,
57 kusanagi 1.3 & calpuls
58    
59 kusanagi 2.3 save / calpul /
60     c
61 kusanagi 1.3
62 kusanagi 2.5 COMMON /VARIE/ dump, CONTR, merror
63 kusanagi 1.3 SAVE /VARIE/
64    
65    
66     C
67     C Begin !
68     C
69 kusanagi 1.8 if (dump.eq.0) dump = -1
70 kusanagi 2.4 if (iev.lt.0.or.iev.gt.9000000) iev = 0
71     call clearall
72     do i = 1, 4
73     pstwerr(i) = 0
74     pperror(i) = 0.
75     error(i) = 0
76     e2(i) = 0
77     enddo
78 kusanagi 1.3 me = 0
79 kusanagi 1.7 lleng = 0
80 kusanagi 1.3 ic = 0
81 kusanagi 1.7 c
82     pari = 0
83     IF (MOD(LUNG,2).EQ.0) THEN
84     lunga = lung / 2
85     pari = 1
86     else
87     lunga = int(lung/2) + 1
88     endif
89     c
90 kusanagi 1.8 if (lunga.gt.60000.and.dump.gt.0) then
91 kusanagi 2.1 print *,'Calorimeter WARNING: more than 30000 words!'
92 kusanagi 1.8 lunga = 60000
93 kusanagi 1.7 endif
94 kusanagi 1.3 c
95     length = ic
96     c
97     20 continue
98 kusanagi 1.6 ic = ic + length + 1
99 kusanagi 1.5 32 continue
100 kusanagi 1.3 ke = 0
101     do while (ke.eq.0)
102     C
103     C Check consistency of header.
104     C it is composed by CODE+D# (8 bits) and by SATUS WORD (8 bits)
105     c so we must split vect into the two components:
106     C
107     C ST1 is CODE + D#
108 kusanagi 1.6 c
109     st1b = 0
110     st2b = 0
111     do bit = 0, 7
112     bi = ibits(vecta(ic),bit,1)
113     if (bi.eq.1) st1b = ibset(st1b,bit)
114     bi = ibits(vecta(ic+1),bit,1)
115     if (bi.eq.1) st2b = ibset(st2b,bit)
116     enddo
117     c
118 kusanagi 1.3 C ST2 is the STATUS WORD
119 kusanagi 1.6 c
120     length2 = 0
121     do bit=0, 7
122     bi = ibits(vecta(ic+3),bit,1)
123     if (bi.eq.1) length2 = ibset(length2,bit)
124     bi = ibits(vecta(ic+2),bit,1)
125     if (bi.eq.1) length2 = ibset(length2,bit+8)
126     enddo
127     c the crc should be at vect(length) with
128     length = length2 + 1
129     C
130     c some checks to be sure we have found the calorimeter data:
131     c
132     c status word is always less then 129
133     c
134     if (st2b.gt.128) then
135     length = 0
136     goto 100
137     endif
138     c
139     c length of the packet must be less then 20000 if no errors
140     c are found
141     c
142 kusanagi 1.7 if (st2b.eq.0.and.length2.gt.lunga) then
143 kusanagi 1.6 length = 0
144     goto 100
145     endif
146 kusanagi 1.3 c
147 kusanagi 1.6 if (length2.le.0) then
148     length = 0
149     goto 100
150     endif
151     c
152     c is it the first section?
153 kusanagi 2.4 c
154     if (st1b.eq.XE.and.length2.eq.1057) then
155 kusanagi 1.6 c if so go out of this loop and go on recording data
156 kusanagi 2.4 ke = 1
157     m = ic
158     contr = 1
159 kusanagi 2.6 if (iev.eq.dump) then
160     print *,'1m,lunga,lleng,lung,pari',m,lunga,lleng,lung,
161     & pari
162     endif
163 kusanagi 2.4 call fillin(m,lunga,lleng,lung,pari,vect,vecta)
164     icb = 1
165     E2(contr) = vect(icb)
166     goto 9
167 kusanagi 1.3 ENDIF
168     C
169 kusanagi 1.6 c the same for the second section, ...
170 kusanagi 2.4 C
171     if (st1b.eq.XO.and.length2.eq.1057) then
172     contr = 2
173     ke = 1
174     m = ic
175     call fillin(m,lunga,lleng,lung,pari,vect,vecta)
176     icb = 1
177     E2(contr) = vect(icb)
178     goto 9
179 kusanagi 1.3 ENDIF
180 kusanagi 1.6 c
181     C ... for the third,...
182     c
183 kusanagi 2.4 if (st1b.eq.YE.and.length2.eq.1057) then
184     contr = 3
185     ke = 1
186     m = ic
187     call fillin(m,lunga,lleng,lung,pari,vect,vecta)
188     icb = 1
189     E2(contr) = vect(icb)
190     goto 9
191 kusanagi 1.3 ENDIF
192     C
193 kusanagi 1.6 c ...and for the last section.
194     c
195 kusanagi 2.4 if (st1b.eq.YO.and.length2.eq.1057) then
196     contr = 4
197     ke = 1
198     m = ic
199     call fillin(m,lunga,lleng,lung,pari,vect,vecta)
200     icb = 1
201     E2(contr) = vect(icb)
202 kusanagi 1.3 endif
203     C
204     100 CONTINUE
205 kusanagi 1.6 c
206     c increment vector of one searching for the next section
207     c
208     9 continue
209 kusanagi 1.3 ic = ic + 1
210 kusanagi 1.6 c
211     c if we run out of vector give an error and exit the subroutine
212     c
213 kusanagi 1.7 if (ic.gt.(lung-1)) then
214 kusanagi 1.3 me = 1
215 kusanagi 4.1 c print *,'1 me = 1'
216 kusanagi 2.4 call clearall
217     do i = 1, 4
218     error(i) = 129
219     e2(i) = 0
220     pstwerr(i) = 0
221     enddo
222 kusanagi 1.3 goto 200
223     endif
224     enddo
225     C
226     10 FORMAT(2X,'Error for view:',2X,I1,2X,'Status word:',2X,Z4)
227     11 FORMAT(2X,'View or command not recognized for view:',2X,I1,2X,
228     & 'Status word:',2X,Z4)
229     12 FORMAT(2X,'Error - did NOT find view:',2X,I1)
230     13 FORMAT(2X,'Error - eof reached, exiting')
231 kusanagi 1.9 21 FORMAT(2X,'CRC: ',2X,Z8)
232 kusanagi 2.4 C
233 kusanagi 1.3 K = CONTR
234 kusanagi 1.6 ic0 = icb
235     ic = ic - 1
236     icb = icb + 1
237     length = vect(icb) + 2
238     length2 = vect(icb)
239 kusanagi 1.7 lleng = (length * 2) - 1
240 kusanagi 1.3 C
241     C Check consistency of CRC.
242     C
243     check = 0.
244     inf = ic0
245     sup = length - 1
246     do i = inf,sup
247     check=crc(check,vect(i))
248     enddo
249     if (check.ne.vect(length)) then
250     ERROR(contr) = 132
251 kusanagi 4.1 c print *,'2 me = 1'
252 kusanagi 1.3 me = 1
253     goto 200
254 kusanagi 2.4 endif
255 kusanagi 1.8
256 kusanagi 2.4 if (iev.eq.dump) write(*,21)vect(length)
257     if (iev.eq.dump) write(*,21)check
258 kusanagi 1.8 c
259 kusanagi 1.3 C
260     C Process data.
261     C
262 kusanagi 1.6 if (k.eq.1) then
263 kusanagi 2.4 k = 1
264 kusanagi 1.6 goto 49
265     endif
266     if (k.eq.2) then
267 kusanagi 2.4 k = 3
268 kusanagi 1.6 goto 49
269     endif
270     if (k.eq.3) then
271 kusanagi 2.4 k = 4
272 kusanagi 1.6 goto 49
273     endif
274 kusanagi 2.4 if (k.eq.4) k = 2
275 kusanagi 1.6 c
276     49 continue
277     c
278 kusanagi 4.1 do i = 1,11
279     do j = 1,96
280 kusanagi 2.4 icb = icb + 1
281 kusanagi 1.6 if (k.eq.1) then
282     calpuls(k,i,97-j) = vect(icb)
283     else
284     calpuls(k,i,j) = vect(icb)
285     endif
286 kusanagi 1.3 enddo
287     enddo
288 kusanagi 4.1 c print *,'3 me = 0'
289 kusanagi 1.3 me = 0
290     c
291     50 continue
292     c
293     C
294     200 continue
295     C
296 kusanagi 1.7 do l = 1, 4
297     do bit=0, 31
298     if (bit.lt.16) then
299     bi = ibits(E2(L),bit,1)
300     else
301     bi = 0
302     endif
303 kusanagi 2.1 if (l.ne.contr) bi = 0
304     if (bi.eq.1) then
305 kusanagi 2.3 pstwerr(l) = ibset(pstwerr(l),bit)
306 kusanagi 2.1 else
307 kusanagi 2.3 pstwerr(l) = ibclr(pstwerr(l),bit)
308 kusanagi 2.1 endif
309 kusanagi 1.7 enddo
310 kusanagi 2.4 pperror(l) = float(error(l))
311 kusanagi 1.7 enddo
312     C
313 kusanagi 2.4 iev = iev + 1
314 kusanagi 1.3 RETURN
315     END
316 kusanagi 2.1
317    

  ViewVC Help
Powered by ViewVC 1.1.23