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

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

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

revision 2.2 by kusanagi, Mon Oct 18 13:01:32 2004 UTC revision 2.3 by kusanagi, Fri Dec 3 22:08:10 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: 2.18.3 *  C     * Version: 3.0.01 *
5  C  C
6  C     (see calunpack for changelog)  C     3.0.00 - 3.0.01: (2004-11-08) changes in the commons (one more common for
7    C                     calpulse and from calstripshit to calstriphit).
8    C
9    C     previous - 3.0.00: (2004-10-25) cleanup, some small bugs fixed
10  C  C
11  C     - fixed compilation error  C     - fixed compilation error
12  C  C
# Line 15  C--------------------------------------- Line 18  C---------------------------------------
18  C  C
19  C Normal variables definition  C Normal variables definition
20  C  C
21        INTEGER ERROR(4)        integer lung
 C  
       integer lung, me, lleng  
       INTEGER i, j, ival, iev  
22        INTEGER NPLA, NCHA, LENSEV        INTEGER NPLA, NCHA, LENSEV
23        PARAMETER (NPLA=22,NCHA=96,LENSEV=NPLA*NCHA)        PARAMETER (NPLA=22,NCHA=96,LENSEV=NPLA*NCHA)
24  C  C
       INTEGER*2 VECT(60000)  
25        INTEGER*1 VECTA(lung)        INTEGER*1 VECTA(lung)
26          INTEGER*2 VECT(60000)
27  C  C
28        integer*2 check, crc, e2(4)        integer*2 check, crc, e2(4)
29          INTEGER*2 length, length2
30          integer*4 chksum, chksum2
31  C  C
32        INTEGER ic, k, ke, ic0,l        integer me, lleng
33        INTEGER status,contr,m        INTEGER i, j, iev
34          INTEGER ERROR(4)
35          INTEGER ic, k, ke, ic0, l
36          INTEGER contr, m
37        INTEGER inf, sup,iev2        INTEGER inf, sup,iev2
38        INTEGER XO, YO, XE, YE        INTEGER XO, YO, XE, YE
39        integer*4 chksum        integer st1b, st2b, bit, bi, icb
40        integer*4 chksum2, chksum1, chksum3        INTEGER lunga, pari
41          integer stwerr(4),dump, cstwerr(4)
42          integer pstwerr(4),IEV3
43        INTEGER*2 length, length2  C
       integer st1b, st2b,p,bit,bi,icb  
       INTEGER st1, st3  
       INTEGER st2, lunga, llung, pari  
   
44        REAL calped(4,11,96), calgood(4,11,96), calthr(4,11,6)        REAL calped(4,11,96), calgood(4,11,96), calthr(4,11,6)
45        REAL calrms(4,11,96), calbase(4,11,6), calvar(4,11,6)        REAL calrms(4,11,96), calbase(4,11,6), calvar(4,11,6)
   
       DATA XO/177/ ! CODE_DSP_R XO = 101 10001  
       DATA YO/173/ ! CODE_DSP_R YO = 101 01101  
       DATA XE/170/ ! CODE_DSP_R XE = 101 01010  
       DATA YE/182/ ! CODE_DSP_R YE = 101 10110  
         
46        REAL calpuls(4,11,96)        REAL calpuls(4,11,96)
47        real calselftrig(4,7), calIItrig(4), calstripshit(4)        real calselftrig(4,7), calIItrig(4), calstriphit(4)
48        real calDSPtaberr(4), calevnum(4)        real calDSPtaberr(4), calevnum(4)
49        REAL DEXY(2,NPLA,NCHA), dexyc(2,npla,ncha), base(2,npla,6)        REAL DEXY(2,NPLA,NCHA), dexyc(2,npla,ncha), base(2,npla,6)
50        real perror(4)        real perror(4), cperror(4)
51        integer stwerr(4),dump        real pperror(4)
52    C
53          DATA YE/182/ ! CODE_DSP_R YE = 101 10110
54          DATA YO/173/ ! CODE_DSP_R YO = 101 01101
55          DATA XE/170/ ! CODE_DSP_R XE = 101 01010
56          DATA XO/177/ ! CODE_DSP_R XO = 101 10001
57          
58        COMMON / evento / IEV, stwerr,perror,        COMMON / evento / IEV, stwerr,perror,
59       &     dexy,dexyc,base,       &     dexy,dexyc,base,
60       &     calselftrig,calIItrig,       &     calselftrig,calIItrig,
61       &     calstripshit,calDSPtaberr,calevnum       &     calstriphit,calDSPtaberr,calevnum
62                
63        save / evento /        save / evento /
64    
65        COMMON / calib / IEV2, calped, calgood, calthr, calrms,        COMMON / calib / IEV2, cstwerr, cperror,
66       &     calbase,       &     calped, calgood, calthr, calrms,
67       &     calvar,       &     calbase, calvar
      &     calpuls  
68    
69        save / calib /        save / calib /
70    
71          COMMON / calpul / IEV3, pstwerr, pperror,
72         &     calpuls
73    
74          save / calpul /
75    
76    c
77        COMMON /VARIE/ dump, contr        COMMON /VARIE/ dump, contr
78        SAVE /VARIE/        SAVE /VARIE/
79            
80  C          C        
81  C Begin !  C Begin !
82  C  C
83        if (dump.eq.0) dump=-1        if (dump.eq.0) dump = -1
84    C
85    C     DEBUG: PRINT OUT THE INPUT VECTOR
86    C
87          if (iev2.eq.dump) then
88             do l=1,lung
89                write(*,17)l,vecta(l)
90             enddo
91          endif
92     17   FORMAT(2X,'Elemento:',2X,I6,2X,' word:',2X,Z8)
93    C    
94        if (iev2.lt.0.or.iev2.gt.9000000) iev2 = 0        if (iev2.lt.0.or.iev2.gt.9000000) iev2 = 0
95        ival = 0  C    
96          call clearall
97          do i = 1, 4
98             cstwerr(i) = 0
99             cperror(i) = 0.
100             error(i) = 0
101             e2(i) = 0            
102             stwerr(i) = 0
103          enddo
104        contr = 1        contr = 1
 C  
105        me = 0        me = 0
106        lleng = 0        lleng = 0
107        ic = 8        ic = 0
108        pari = 0        pari = 0
109          length = 0
110    C
111    C     input length must be > 0, if not go out with error code 142
112    C
113          if (lung.le.0) then
114             if (dump.eq.iev) print *,'lung = ',lung      
115             do i=1,4
116                error(i)=142
117             enddo
118             goto 200
119          endif
120    C
121        IF (MOD(LUNG,2).EQ.0) THEN        IF (MOD(LUNG,2).EQ.0) THEN
122           lunga = lung / 2           lunga = lung / 2
123           pari = 1           pari = 1
# Line 95  c Line 129  c
129           print *,'Calorimeter WARNING: more than 60000 words!'           print *,'Calorimeter WARNING: more than 60000 words!'
130           lunga = 60000           lunga = 60000
131        endif        endif
 c  
       length = ic  
132  c  c
133   20   CONTINUE   20   CONTINUE
134        ic = ic + length + 1        ic = ic + length + 1
135   32   continue   32   continue
136        ke = 0        ke = 0
137        do while (ke.eq.0)        do while (ke.eq.0)
138  C  C    
139  C Check consistency of header.  C     Check consistency of header.
140  C it is composed by CODE+D# (8 bits) and by SATUS WORD (8 bits)  C     it is composed by CODE+D# (8 bits) and by SATUS WORD (8 bits)
141  c so we must split vect into the two components:  c     so we must split vect into the two components:
142  C  C    
143  C ST1 is CODE + D#  C     ST1 is CODE + D#
144  c  c    
145           st1b = 0           st1b = 0
146           st2b = 0           st2b = 0
147           do bit = 0, 7           do bit = 0, 7
# Line 142  c Line 174  c
174  c  c
175  c     length of the packet must be less then 20000 if no errors  c     length of the packet must be less then 20000 if no errors
176  c     are found  c     are found
177  c  c    
178           if (st2b.eq.0.and.length2.gt.lunga) then           if (st2b.eq.0.and.length2.gt.lunga) then
179              length = 0              length = 0
180              goto 100              goto 100
# Line 153  c     Line 185  c    
185              goto 100              goto 100
186           endif           endif
187  c  c
          e2(contr) = 0  
 C  
 c         if (contr.eq.1) then  
 c  
188  c     is it the first section?  c     is it the first section?
189  c  c    
190              if (st1b.eq.YE) then           if (st1b.eq.YE.and.length2.eq.4629) then
191  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
192                 ke = 1              ke = 1
193                 m = ic              m = ic
194                 contr = 1              contr = 1
195                 call fillin(m,lunga,lleng,lung,pari,vect,vecta)              call fillin(m,lunga,lleng,lung,pari,vect,vecta)
196                 icb = 1              icb = 1
197  c               if (st2b.ne.0) then              E2(contr) = vect(icb)                  
198                    E2(contr) = vect(icb)                                goto 9
199  c               endif           endif
                goto 9  
 c            else  
 cc    if not, is it one of the next sections? did we miss a section?  
 c              if (st1b.eq.YO.or.st1b.eq.XE.or.st1b.eq.XO) THEN  
 cc    if so, record an error and go back analizing this section  
 c                 contr = 1  
 c                 error(contr) = 129  
 cc                 contr = 2  
 c                 goto 32  
 cc               ELSE  
 ccc    if it is not the case, go on with the next value of vect  
 cc                  ERROR(contr) = 128    
 cc                  GOTO 100  
 c               endif  
             endif  
 c         ENDIF  
200  C              C            
201  c    the same for the second section, ...  c    the same for the second section, ...
202  c  c
203  c         if (CONTR.eq.2) then               if (st1b.eq.YO.and.length2.eq.4629) then
204              if (st1b.eq.YO) then              ke = 1                  
205                 ke = 1                                contr = 2
206                 contr = 2              m = ic
207                 m = ic              call fillin(m,lunga,lleng,lung,pari,vect,vecta)
208                 call fillin(m,lunga,lleng,lung,pari,vect,vecta)              icb = 1
209                 icb = 1              E2(contr) = vect(icb)
210  c               if (st2b.ne.0) then              goto 9
211                    E2(contr) = vect(icb)           endif
 c               endif  
                goto 9  
 c            else  
 c               if (st1b.eq.XE.or.st1b.eq.XO) then  
 c                  contr = 2  
 c                  error(contr) = 129  
 cc                  contr = 3  
 c                  goto 32  
 cc               ELSE  
 cc                  ERROR(contr) = 128  
 cc                  GOTO 100  
 c               endif  
             endif  
 c         ENDIF  
212  c  c
213  C     ... for the third,...  C     ... for the third,...
214  c  c
215  c         if (CONTR.eq.3) then           if (st1b.eq.XE.and.length2.eq.4629) then
216              if (st1b.eq.XE) then              ke = 1
217                 ke = 1              m = ic
218                 m = ic              contr = 3
219                 contr = 3              call fillin(m,lunga,lleng,lung,pari,vect,vecta)
220                 call fillin(m,lunga,lleng,lung,pari,vect,vecta)              icb = 1
221                 icb = 1              E2(contr) = vect(icb)
222  c               if (st2b.ne.0) then              goto 9
223                    E2(contr) = vect(icb)           endif
 c               endif  
                goto 9  
 c            else  
 c               if (st1b.eq.XO) then  
 c                  contr = 3  
 c                  error(contr) = 129  
 cc                  contr = 4  
 c                  goto 32  
 cc               ELSE  
 cc                  ERROR(contr) = 128  
 cc                  GOTO 100  
 c               endif  
             endif  
 c         ENDIF  
224  C  C
225  c     ...and for the last section.  c     ...and for the last section.
226  c  c
227  c         if (CONTR.eq.4) then           if (st1b.eq.XO.and.length2.eq.4629) then
228              if (st1b.eq.XO) then              contr = 4
229                 contr = 4              ke = 1
230                 ke = 1              m = ic
231                 m = ic              call fillin(m,lunga,lleng,lung,pari,vect,vecta)
232                 call fillin(m,lunga,lleng,lung,pari,vect,vecta)              icb = 1
233                 icb = 1              E2(contr) = vect(icb)
234  c               if (st2b.ne.0) then           endif  
                   E2(contr) = vect(icb)  
 c               endif  
 c            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  
 c               ERROR(contr) = 128  
 c               goto 100  
             endif    
 c         endif  
235  C      C    
236   100     CONTINUE   100     CONTINUE
237  c  c    
238  c     increment vector of one searching for the next section  c     increment vector of one searching for the next section
239  c  c
240   9       continue   9       continue
# Line 269  c Line 243  c
243  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
244  c      c    
245           if (ic.gt.(lung-1)) then           if (ic.gt.(lung-1)) then
             if (contr.ne.1) contr=5              
             error(contr) = 130  
246              me = 1              me = 1
247                call clearall
248                do i = 1, 4
249                   error(i) = 129            
250                   e2(i) = 0            
251                   stwerr(i) = 0
252                enddo
253              goto 200              goto 200
254           endif           endif
255        enddo        enddo
# Line 294  C       Line 272  C      
272           length2 = vect(icb)           length2 = vect(icb)
273           lleng = (length * 2) - 1           lleng = (length * 2) - 1
274  C  C
 C Check validity of length.  
 C  
          if (vect(icb).ne.4629) then  
             ERROR(contr) = 131  
 c            me = 1  
             goto 200  
          endif  
 C  
275  C Check consistency of CRC.  C Check consistency of CRC.
276  C  C
277           check = 0.           check = 0.
# Line 312  C Line 282  C
282           enddo           enddo
283           if (check.ne.vect(length)) then           if (check.ne.vect(length)) then
284              ERROR(contr) = 132              ERROR(contr) = 132
 c            me = 1  
285              goto 200              goto 200
286           endif           endif
287  C  C
# Line 423  c Line 392  c
392                 endif                 endif
393              enddo              enddo
394           enddo           enddo
 c         CONTR = CONTR + 1  
395           me = 0           me = 0
396  c  c
 c         if (contr.eq.5) contr = 1  
397  c  c
398   50      continue   50      continue
399  C  C
400   200  continue   200  continue
 c      if (error(1).eq.129.and.error(2).eq.129  
 c     &     .and.error(3).eq.129.and.error(4).eq.130) then  
 c         call azero(error,4)  
 c         contr=1  
 c         me = 1  
 c      endif  
401  C  C
402        do l = 1, 4        do l = 1, 4
403           do bit=0, 31           do bit=0, 31
# Line 445  C Line 406  C
406              else              else
407                 bi = 0                 bi = 0
408              endif              endif
             if (l.ne.contr) bi = 0  
409              if (bi.eq.1) then              if (bi.eq.1) then
410                 stwerr(l) = ibset(stwerr(l),bit)                 stwerr(l) = ibset(stwerr(l),bit)
411              else              else
412                 stwerr(l) = ibclr(stwerr(l),bit)                 stwerr(l) = ibclr(stwerr(l),bit)
413              endif              endif
414           enddo           enddo
415           if (l.eq.contr) then           perror(l) = float(error(l))
416              perror(l) = float(error(l))           cstwerr(l) = stwerr(l)
417           else           cperror(l) = perror(l)
             perror(l) = 0.  
          endif  
418        enddo        enddo
419  C  C      
420        if (me.eq.0) iev2 = iev2 + 1        iev2 = iev2 + 1
421  C  C
422        RETURN        RETURN
423        END        END
424    
   
Legend:
Removed from v.2.2  
changed lines
  Added in v.2.3
  ViewVC Help
Powered by ViewVC 1.1.23