/[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 2.3 by kusanagi, Fri Dec 3 22:08:10 2004 UTC revision 2.4 by kusanagi, Thu Dec 16 17:33:01 2004 UTC
# Line 1  Line 1 
1  C  C
2  C  Written by Mirko Boezio and Emiliano Mocchiutti  C  Written by Mirko Boezio and Emiliano Mocchiutti
3  C  C
4  C     * Version: 3.0.0 *  C     * Version: 3.1.1 *
5    C
6    C     3.1.0 - 3.1.1: (2004-12-13) bug in filling the calpuls vector. Fixed.
7    C
8    C     3.0.0 - 3.1.0: (2004-12-10) changes in the sections order and increment
9    C                    iev each time calpulse is called. Cleanup of the code.
10  C  C
11  C     0.00.0 - 3.0.0: (2004-11-08) changes in the commons (one more common for  C     0.00.0 - 3.0.0: (2004-11-08) changes in the commons (one more common for
12  C                     calpulse and from calstripshit to calstriphit).  C                     calpulse and from calstripshit to calstriphit).
# Line 16  C--------------------------------------- Line 21  C---------------------------------------
21  C  C
22  C Normal variables definition  C Normal variables definition
23  C  C
24        INTEGER ERROR(4)        INTEGER i, j, lung, me
 C  
       INTEGER i, j, iev,iev2, lung, me  
25        INTEGER NPLA, NCHA, LENSEV        INTEGER NPLA, NCHA, LENSEV
26        PARAMETER (NPLA=22,NCHA=96,LENSEV=NPLA*NCHA)        PARAMETER (NPLA=22,NCHA=96,LENSEV=NPLA*NCHA)
27  C  C
28        INTEGER*2 VECT(60000)        INTEGER*2 VECT(60000)
29        INTEGER*1 VECTA(lung)        INTEGER*1 VECTA(lung)
 C  
30        integer*2 check, crc,e2(4)        integer*2 check, crc,e2(4)
31          INTEGER*2 length, length2
32  C  C
33          INTEGER ERROR(4)
34        INTEGER ic, k, ke, ic0        INTEGER ic, k, ke, ic0
35        INTEGER status, CONTR,m        INTEGER CONTR, m
36        INTEGER inf, sup, lunga,lleng,l        INTEGER inf, sup, lunga,lleng,l
37        INTEGER XO, YO, XE, YE        INTEGER XO, YO, XE, YE
38          integer pstwerr(4), IEV
39          integer dump
40          integer st1b, st2b, bit,bi,icb, pari
41    
42        integer st1b, st2b,p,bit,bi,icb, pari        real pperror(4)
       INTEGER*2 length, length2  
   
       INTEGER*2 st1, st2  
   
43        REAL calpuls(4,11,96)        REAL calpuls(4,11,96)
44    
45        DATA XO/177/ ! CODE_DSP_R XO = 101 10001        DATA XO/177/ ! CODE_DSP_R XO = 101 10001
# Line 44  C Line 47  C
47        DATA XE/170/ ! CODE_DSP_R XE = 101 01010        DATA XE/170/ ! CODE_DSP_R XE = 101 01010
48        DATA YE/182/ ! CODE_DSP_R YE = 101 10110        DATA YE/182/ ! CODE_DSP_R YE = 101 10110
49    
50        REAL calped(4,11,96), calgood(4,11,96), calthr(4,11,6)        COMMON / calpul / iev, pstwerr, pperror,
       REAL calrms(4,11,96), calbase(4,11,6), calvar(4,11,6)  
   
       real calselftrig(4,7), calIItrig(4), calstriphit(4)  
       real calDSPtaberr(4), calevnum(4)  
       REAL DEXY(2,NPLA,NCHA), dexyc(2,npla,ncha), base(2,npla,6)  
       real perror(4), cperror(4)  
       real pperror(4)  
       integer pstwerr(4), IEV3  
       integer cstwerr(4)  
       integer stwerr(4), dump  
   
       COMMON / evento / IEV, stwerr,perror,  
      &     dexy,dexyc,base,  
      &     calselftrig,calIItrig,  
      &     calstriphit,calDSPtaberr,calevnum  
         
       save / evento /  
   
       COMMON / calib / IEV2, cstwerr, cperror,  
      &     calped, calgood, calthr, calrms,  
      &     calbase,  
      &     calvar  
   
       save / calib /  
   
       COMMON / calpul / IEV3, pstwerr, pperror,  
51       &     calpuls       &     calpuls
52    
53        save / calpul /        save / calpul /
   
54  c  c
55    
56        COMMON /VARIE/ dump, CONTR        COMMON /VARIE/ dump, CONTR
# Line 85  C         Line 61  C        
61  C Begin !  C Begin !
62  C  C
63        if (dump.eq.0) dump = -1        if (dump.eq.0) dump = -1
64        if (iev3.lt.0.or.iev3.gt.9000000) iev3 = 0        if (iev.lt.0.or.iev.gt.9000000) iev = 0
65          call clearall
66          do i = 1, 4
67             pstwerr(i) = 0
68             pperror(i) = 0.
69             error(i) = 0
70             e2(i) = 0
71          enddo
72        me = 0        me = 0
73        lleng = 0        lleng = 0
74        ic = 0        ic = 0
# Line 119  C ST1 is CODE + D# Line 102  C ST1 is CODE + D#
102  c  c
103           st1b = 0           st1b = 0
104           st2b = 0           st2b = 0
          if ((ic+3).gt.lung) then  
             error(contr) = 130  
             if (contr.ne.1) contr=5  
             me = 1  
             goto 200  
          endif  
105           do bit = 0, 7           do bit = 0, 7
106              bi = ibits(vecta(ic),bit,1)              bi = ibits(vecta(ic),bit,1)
107              if (bi.eq.1) st1b = ibset(st1b,bit)              if (bi.eq.1) st1b = ibset(st1b,bit)
# Line 166  c     Line 143  c    
143              goto 100              goto 100
144           endif           endif
145  c  c
          e2(contr) = 0  
 C  
          if (contr.eq.1) then  
 c  
146  c     is it the first section?  c     is it the first section?
147  c  c    
148              if (st1b.eq.YE) then           if (st1b.eq.XE.and.length2.eq.1057) then
149  c     if so go out of this loop and go on recording data  c     if so go out of this loop and go on recording data
150                 ke = 1              ke = 1
151                 m = ic              m = ic
152                 call fillin(m,lunga,lleng,lung,pari,vect,vecta)              contr = 1
153                 icb = 1              call fillin(m,lunga,lleng,lung,pari,vect,vecta)
154  c               if (st2b.ne.0) then              icb = 1
155                    E2(contr) = vect(icb)              E2(contr) = vect(icb)
156  c               endif              goto 9
                goto 9  
             else  
 c    if not, is it one of the next sections? did we miss a section?  
               if (st1b.eq.YO.or.st1b.eq.XE.or.st1b.eq.XO) THEN  
 c     if so, record an error and go back analizing this section  
                  error(contr) = 129  
                  contr = 2  
                  goto 32  
                ELSE  
 c   if it is not the case, go on with the next value of vect  
                   ERROR(contr) = 128    
                   GOTO 100  
                endif  
             endif  
157           ENDIF           ENDIF
158  C              C            
159  c     the same for the second section, ...  c     the same for the second section, ...
160  c  C
161           if (CONTR.eq.2) then               if (st1b.eq.XO.and.length2.eq.1057) then
162              if (st1b.eq.YO) then              contr = 2
163                 ke = 1                                ke = 1                  
164                 m = ic              m = ic
165                 call fillin(m,lunga,lleng,lung,pari,vect,vecta)              call fillin(m,lunga,lleng,lung,pari,vect,vecta)
166                 icb = 1              icb = 1
167  c               if (st2b.ne.0) then              E2(contr) = vect(icb)
168                    E2(contr) = vect(icb)              goto 9
 c               endif  
                goto 9  
             else  
                if (st1b.eq.XE.or.st1b.eq.XO) then  
                   error(contr) = 129  
                   contr = 3  
                   goto 32  
                ELSE  
                   ERROR(contr) = 128  
                   GOTO 100  
                endif  
             endif  
169           ENDIF           ENDIF
170  c  c
171  C     ... for the third,...  C     ... for the third,...
172  c  c
173           if (CONTR.eq.3) then           if (st1b.eq.YE.and.length2.eq.1057) then
174              if (st1b.eq.XE) then              contr = 3
175                 ke = 1              ke = 1
176                 m = ic              m = ic
177                 call fillin(m,lunga,lleng,lung,pari,vect,vecta)              call fillin(m,lunga,lleng,lung,pari,vect,vecta)
178                 icb = 1              icb = 1
179  c               if (st2b.ne.0) then              E2(contr) = vect(icb)
180                    E2(contr) = vect(icb)              goto 9
 c               endif  
                goto 9  
             else  
                if (st1b.eq.XO) then  
                   error(contr) = 129  
                   contr = 4  
                   goto 32  
                ELSE  
                   ERROR(contr) = 128  
                   GOTO 100  
                endif  
             endif  
181           ENDIF           ENDIF
182  C  C
183  c     ...and for the last section.  c     ...and for the last section.
184  c  c
185           if (CONTR.eq.4) then           if (st1b.eq.YO.and.length2.eq.1057) then
186              if (st1b.eq.XO) then              contr = 4
187                 ke = 1              ke = 1
188                 m = ic              m = ic
189                 call fillin(m,lunga,lleng,lung,pari,vect,vecta)              call fillin(m,lunga,lleng,lung,pari,vect,vecta)
190                 icb = 1              icb = 1
191  c               if (st2b.ne.0) then              E2(contr) = vect(icb)
                   E2(contr) = vect(icb)  
 c               endif  
             else  
 c     we should never arrive here (in case we run out of vector if section  
 c     four is missing!)... however here it is in case of bugs!  
 c  
                ERROR(contr) = 128  
                goto 100  
             endif    
192           endif           endif
193  C      C    
194   100     CONTINUE   100     CONTINUE
# Line 275  c Line 201  c
201  c     if we run out of vector give an error and exit the subroutine  c     if we run out of vector give an error and exit the subroutine
202  c      c    
203           if (ic.gt.(lung-1)) then           if (ic.gt.(lung-1)) then
             error(contr) = 130  
             if (contr.ne.1) contr=5  
204              me = 1              me = 1
205                call clearall
206                do i = 1, 4
207                   error(i) = 129            
208                   e2(i) = 0            
209                   pstwerr(i) = 0
210                enddo
211              goto 200              goto 200
212           endif           endif
213        enddo        enddo
# Line 288  C               Line 218  C              
218   12      FORMAT(2X,'Error - did NOT find view:',2X,I1)   12      FORMAT(2X,'Error - did NOT find view:',2X,I1)
219   13      FORMAT(2X,'Error - eof reached, exiting')   13      FORMAT(2X,'Error - eof reached, exiting')
220   21      FORMAT(2X,'CRC: ',2X,Z8)   21      FORMAT(2X,'CRC: ',2X,Z8)
221  C  C    
222           K = CONTR           K = CONTR
223           ic0 = icb           ic0 = icb
224           ic = ic - 1           ic = ic - 1
# Line 297  C Line 227  C
227           length2 = vect(icb)           length2 = vect(icb)
228           lleng = (length * 2) - 1           lleng = (length * 2) - 1
229  C  C
 C Check validity of length.  
 C  
          if (vect(icb).ne.1057) then  
             ERROR(contr) = 131  
             me = 1  
             goto 200  
          endif  
 C  
230  C Check consistency of CRC.  C Check consistency of CRC.
231  C  C
232           check = 0.           check = 0.
# Line 317  C Line 239  C
239              ERROR(contr) = 132              ERROR(contr) = 132
240              me = 1              me = 1
241              goto 200              goto 200
242           endif           endif        
243    
244        if (iev2.eq.dump) write(*,21)vect(length)        if (iev.eq.dump) write(*,21)vect(length)
245        if (iev2.eq.dump) write(*,21)check              if (iev.eq.dump) write(*,21)check      
246  c  c
247  C  C
248  C Process data.  C Process data.
249  C  C
250           if (k.eq.1) then           if (k.eq.1) then
251              k = 4              k = 1
252              goto 49              goto 49
253           endif           endif
254           if (k.eq.2) then           if (k.eq.2) then
255              k = 2              k = 3
256              goto 49              goto 49
257           endif           endif
258           if (k.eq.3) then           if (k.eq.3) then
259              k = 1              k = 4
260              goto 49              goto 49
261           endif           endif
262           if (k.eq.4) k = 3           if (k.eq.4) k = 2
263  c  c
264   49      continue   49      continue
265  c  c
266           do j = 1,96           do j = 1,96
267              do i = 1,11              do i = 1,11
268                 ic = ic + 1                 icb = icb + 1
269                 if (k.eq.1) then                 if (k.eq.1) then
270                    calpuls(k,i,97-j) = vect(icb)                    calpuls(k,i,97-j) = vect(icb)
271                 else                 else
# Line 351  c Line 273  c
273                 endif                 endif
274             enddo             enddo
275           enddo           enddo
          CONTR = contr + 1  
276           me = 0           me = 0
 c    
          if (contr.eq.5) contr = 1  
277  c  c
278   50      continue   50      continue
279  c  c
280  C      C    
281   200  continue   200  continue
282  C  C
       if (error(1).eq.129.and.error(2).eq.129  
      &     .and.error(3).eq.129.and.error(4).eq.130) then  
          call azero(error,4)  
          me = 1  
          contr=1        
       endif  
 C  
283        do l = 1, 4        do l = 1, 4
284           do bit=0, 31           do bit=0, 31
285              if (bit.lt.16) then              if (bit.lt.16) then
# Line 382  C Line 294  C
294                 pstwerr(l) = ibclr(pstwerr(l),bit)                 pstwerr(l) = ibclr(pstwerr(l),bit)
295              endif              endif
296           enddo           enddo
297           if (l.eq.contr) then           pperror(l) = float(error(l))
             pperror(l) = float(error(l))  
          else  
             pperror(l) = 0.  
          endif  
298        enddo        enddo
299  C  C
300        if (me.eq.0) iev3 = iev3 + 1        iev = iev + 1
301        RETURN        RETURN
302        END        END
303    
Legend:
Removed from v.2.3  
changed lines
  Added in v.2.4
  ViewVC Help
Powered by ViewVC 1.1.23