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

Diff of /yoda/techmodel/forroutines/calorimeter/calpulse.for

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.5 by kusanagi, Thu Jul 8 13:06:45 2004 UTC revision 1.6 by kusanagi, Sat Jul 17 20:03:44 2004 UTC
# Line 1  Line 1 
1    
2  C------------------------------------------------  C------------------------------------------------
3  c      SUBROUTINE CALPULSE(vect,ERROR,calpulse,CONTR,e2)  c      SUBROUTINE CALPULSE(vect,ERROR,calpulse,CONTR,e2)
4        SUBROUTINE CALPULSE(vect,lung,me)        SUBROUTINE CALPULSE(vecta,lung,me)
5  C------------------------------------------------  C------------------------------------------------
6    
7        IMPLICIT NONE        IMPLICIT NONE
# Line 15  C Line 15  C
15        PARAMETER (NPLA=22,NCHA=96,LENSEV=NPLA*NCHA)        PARAMETER (NPLA=22,NCHA=96,LENSEV=NPLA*NCHA)
16  C  C
17        INTEGER*2 VECT(20000)        INTEGER*2 VECT(20000)
18          INTEGER*1 VECTA(40000)
19  C  C
20        integer*2 check, crc,e2(4)        integer*2 check, crc,e2(4)
21  C  C
22        INTEGER ic, k, ke, ic0        INTEGER ic, k, ke, ic0
23        INTEGER status, CONTR        INTEGER status, CONTR,m
24        INTEGER inf, sup        INTEGER inf, sup
25        INTEGER XO, YO, XE, YE        INTEGER XO, YO, XE, YE
26    
27          integer st1b, st2b,p,bit,bi,icb
28        INTEGER*2 length, length2        INTEGER*2 length, length2
29    
30        INTEGER*2 st1, st2        INTEGER*2 st1, st2
# Line 40  C Line 41  C
41    
42        real calselftrig(4,7), calIItrig(4), calstripshit(4)        real calselftrig(4,7), calIItrig(4), calstripshit(4)
43        real calDSPtaberr(4), calevnum(4)        real calDSPtaberr(4), calevnum(4)
44        REAL DEXY(2,NPLA,NCHA), dexyc(2,npla,ncha), base(2,npla,ncha)        REAL DEXY(2,NPLA,NCHA), dexyc(2,npla,ncha), base(2,npla,6)
45    
46        COMMON / evento / IEV,        COMMON / evento / IEV,
47       &     dexy,dexyc,base,       &     dexy,dexyc,base,
# Line 69  c Line 70  c
70        length = ic        length = ic
71  c  c
72   20   continue   20   continue
73  c      ic = ic + length + 1        ic = ic + length + 1
       ic = length + 1  
74   32   continue   32   continue
75        ke = 0        ke = 0
76        do while (ke.eq.0)        do while (ke.eq.0)
# Line 80  C it is composed by CODE+D# (8 bits) and Line 80  C it is composed by CODE+D# (8 bits) and
80  c so we must split vect into the two components:  c so we must split vect into the two components:
81  C  C
82  C ST1 is CODE + D#  C ST1 is CODE + D#
83           status = ISHFT(vect(ic),-8)  c
84           st1 = IAND(status,'00FF'x)           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  C ST2 is the STATUS WORD  C ST2 is the STATUS WORD
94           st2 = IAND(vect(ic),'00FF'x)  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  c      c    
122             if (length2.le.0) then
123                length = 0
124                goto 100
125             endif
126    c
127           e2(contr) = 0           e2(contr) = 0
128  C  C
129           if (contr.eq.1) then           if (contr.eq.1) then
130              if (st1.eq.YE) then  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                 ke = 1                 ke = 1
136                 if (st2.ne.0) then                 m = ic
137                    E2(contr) = vect(ic)                 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                 endif                 endif
151                   goto 9
152              else              else
153                 if (st1.eq.YO.or.st1.eq.XE.or.st1.eq.XO) THEN  c    if not, is it one of the next sections? did we miss a section?
154                    error(contr) = 129                if (st1b.eq.YO.or.st1b.eq.XE.or.st1b.eq.XO) THEN
155                    contr = 2  c     if so, record an error and go back analizing this section
156  c                  length = -1                   error(contr) = 129
157                    goto 32                   contr = 2
158                     goto 32
159                 ELSE                 ELSE
160                    ERROR(contr) = 128  c   if it is not the case, go on with the next value of vect
161                      ERROR(contr) = 128  
162                    GOTO 100                    GOTO 100
163                 endif                 endif
164              endif              endif
165           ENDIF           ENDIF
166  C              C            
167           if (CONTR.eq.2) then  c     the same for the second section, ...
168              if (st1.eq.YO) then  c
169             if (CONTR.eq.2) then    
170                if (st1b.eq.YO) then
171                 ke = 1                                   ke = 1                  
172                 if (st2.ne.0) then                 m = ic
173                    E2(contr) = vect(ic)                 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                 endif                 endif
187                   goto 9
188              else              else
189                 if (st1.eq.XE.or.st1.eq.XO) then                 if (st1b.eq.XE.or.st1b.eq.XO) then
190                    error(contr) = 129                    error(contr) = 129
191                    contr = 3                    contr = 3
 c                  length = -1  
192                    goto 32                    goto 32
193                 ELSE                 ELSE
194                    ERROR(contr) = 128                    ERROR(contr) = 128
# Line 124  c                  length = -1 Line 196  c                  length = -1
196                 endif                 endif
197              endif              endif
198           ENDIF           ENDIF
199  C      c
200    C     ... for the third,...
201    c
202           if (CONTR.eq.3) then           if (CONTR.eq.3) then
203              if (st1.eq.XE) then              if (st1b.eq.XE) then
204                 ke = 1                 ke = 1
205                 if (st2.ne.0) then                 m = ic
206                    E2(contr) = vect(ic)                 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                 endif                 endif
220                   goto 9
221              else              else
222                 if (st1.eq.XO) then                 if (st1b.eq.XO) then
223                    error(contr) = 129                    error(contr) = 129
224                    contr = 4                    contr = 4
 c                  length = -1  
225                    goto 32                    goto 32
226                 ELSE                 ELSE
227                    ERROR(contr) = 128                                  ERROR(contr) = 128
228                    GOTO 100                    GOTO 100
229                 endif                 endif
230              endif              endif
231           ENDIF           ENDIF
232  C  C
233    c     ...and for the last section.
234    c
235           if (CONTR.eq.4) then           if (CONTR.eq.4) then
236              if (st1.eq.XO) then              if (st1b.eq.XO) then
237                 ke = 1                 ke = 1
238                 if (st2.ne.0) then                 m = ic
239                    E2(contr) = vect(ic)                 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                 endif                 endif
253              else              else
254    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                 ERROR(contr) = 128                 ERROR(contr) = 128
258                 GOTO 100                 goto 100
259              endif                endif  
260           endif           endif
261  C      C    
262   100     CONTINUE   100     CONTINUE
263    c
264    c     increment vector of one searching for the next section
265    c
266     9       continue
267           ic = ic + 1           ic = ic + 1
268           if (ic.gt.19999) then  c
269              ERROR(contr) = 130  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              if (contr.ne.1) contr=5              if (contr.ne.1) contr=5
274              me = 1              me = 1
275              goto 200              goto 200
# Line 173  C               Line 283  C              
283   13      FORMAT(2X,'Error - eof reached, exiting')   13      FORMAT(2X,'Error - eof reached, exiting')
284  C  C
285           K = CONTR           K = CONTR
286           ic0 = ic - 1           ic0 = icb
287           length = ic0 + vect(ic) + 1           ic = ic - 1
288           length2 = vect(ic)           icb = icb + 1
289             length = vect(icb) + 2
290             length2 = vect(icb)
291  C  C
292  C Check validity of length.  C Check validity of length.
293  C  C
294           if (vect(ic).ne.1057) then           if (vect(icb).ne.1057) then
295              ERROR(contr) = 131              ERROR(contr) = 131
296              me = 1              me = 1
297              goto 200              goto 200
# Line 201  C Line 313  C
313  C  C
314  C Process data.  C Process data.
315  C  C
316             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           do j = 1,96           do j = 1,96
333              do i = 1,11              do i = 1,11
334                 ic = ic + 1                 ic = ic + 1
335                 calpuls(k,i,j) = vect(ic)                 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             enddo             enddo
341           enddo           enddo
342           CONTR = contr + 1           CONTR = contr + 1
Legend:
Removed from v.1.5  
changed lines
  Added in v.1.6
  ViewVC Help
Powered by ViewVC 1.1.23