/[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.6 by kusanagi, Sat Jul 17 20:03:44 2004 UTC revision 1.7 by kusanagi, Thu Aug 19 15:24:48 2004 UTC
# Line 1  Line 1 
1    C
2    C  Written by Mirko Boezio and Emiliano Mocchiutti
3    C
4    C     * Version: 2.17 *
5    C
6  C------------------------------------------------  C------------------------------------------------
 c      SUBROUTINE CALPULSE(vect,ERROR,calpulse,CONTR,e2)  
7        SUBROUTINE CALPULSE(vecta,lung,me)        SUBROUTINE CALPULSE(vecta,lung,me)
8  C------------------------------------------------  C------------------------------------------------
9    
# Line 14  C Line 17  C
17        INTEGER NPLA, NCHA, LENSEV        INTEGER NPLA, NCHA, LENSEV
18        PARAMETER (NPLA=22,NCHA=96,LENSEV=NPLA*NCHA)        PARAMETER (NPLA=22,NCHA=96,LENSEV=NPLA*NCHA)
19  C  C
20        INTEGER*2 VECT(20000)        INTEGER*2 VECT(30000)
21        INTEGER*1 VECTA(40000)        INTEGER*1 VECTA(lung)
22  C  C
23        integer*2 check, crc,e2(4)        integer*2 check, crc,e2(4)
24  C  C
25        INTEGER ic, k, ke, ic0        INTEGER ic, k, ke, ic0
26        INTEGER status, CONTR,m        INTEGER status, CONTR,m
27        INTEGER inf, sup        INTEGER inf, sup, lunga,lleng,l
28        INTEGER XO, YO, XE, YE        INTEGER XO, YO, XE, YE
29    
30        integer st1b, st2b,p,bit,bi,icb        integer st1b, st2b,p,bit,bi,icb, pari
31        INTEGER*2 length, length2        INTEGER*2 length, length2
32    
33        INTEGER*2 st1, st2        INTEGER*2 st1, st2
# Line 42  C Line 45  C
45        real calselftrig(4,7), calIItrig(4), calstripshit(4)        real calselftrig(4,7), calIItrig(4), calstripshit(4)
46        real calDSPtaberr(4), calevnum(4)        real calDSPtaberr(4), calevnum(4)
47        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)
48          real perror(4)
49          integer stwerr(4)
50    
51        COMMON / evento / IEV,        COMMON / evento / IEV, stwerr,perror,
52       &     dexy,dexyc,base,       &     dexy,dexyc,base,
53       &     calselftrig,calIItrig,       &     calselftrig,calIItrig,
54       &     calstripshit,calDSPtaberr,calevnum       &     calstripshit,calDSPtaberr,calevnum
# Line 57  C Line 62  C
62    
63        save / calib /        save / calib /
64    
65        COMMON /VARIE/error, CONTR, E2        COMMON /VARIE/ error, CONTR, e2
66        SAVE /VARIE/        SAVE /VARIE/
67            
68    
69  C          C        
70  C Begin !  C Begin !
71  C  C
72          if (iev2.lt.0.or.iev2.gt.9000000) iev2 = 0
73        me = 0        me = 0
74          lleng = 0
75        ic = 0        ic = 0
76    c
77          pari = 0
78          IF (MOD(LUNG,2).EQ.0) THEN
79             lunga = lung / 2
80             pari = 1
81          else
82             lunga = int(lung/2) + 1
83          endif
84    c
85          if (lunga.gt.30000) then
86    c         print *,'Calorimeter WARNING: more than 30000 words!'
87             lunga = 30000
88          endif
89  c  c
90        length = ic        length = ic
91  c  c
# Line 83  C ST1 is CODE + D# Line 103  C ST1 is CODE + D#
103  c  c
104           st1b = 0           st1b = 0
105           st2b = 0           st2b = 0
106             if ((ic+3).gt.lung) then
107                error(contr) = 130
108                if (contr.ne.1) contr=5
109                me = 1
110                goto 200
111             endif
112           do bit = 0, 7           do bit = 0, 7
113              bi = ibits(vecta(ic),bit,1)              bi = ibits(vecta(ic),bit,1)
114              if (bi.eq.1) st1b = ibset(st1b,bit)              if (bi.eq.1) st1b = ibset(st1b,bit)
# Line 114  c Line 140  c
140  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
141  c     are found  c     are found
142  c  c
143           if (st2b.eq.0.and.length2.gt.20000) then           if (st2b.eq.0.and.length2.gt.lunga) then
144              length = 0              length = 0
145              goto 100              goto 100
146           endif           endif
# Line 134  c Line 160  c
160  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
161                 ke = 1                 ke = 1
162                 m = ic                 m = ic
163                 do i = 1, 20000                 call riempi(m,lunga,lleng,lung,pari,vect,vecta)
                   vect(i) = 0  
                   do bit=0, 7  
                      bi = ibits(vecta(m+1),bit,1)  
                      if (bi.eq.1) vect(i) = ibset(vect(i),bit)  
                      bi = ibits(vecta(m),bit,1)  
                      if (bi.eq.1) vect(i) = ibset(vect(i),bit+8)  
                   enddo          
                   m = m + 2  
                enddo  
164                 icb = 1                 icb = 1
165                 if (st2b.ne.0) then                 if (st2b.ne.0) then
166                    E2(contr) = vect(icb)                    E2(contr) = vect(icb)
# Line 170  c Line 187  c
187              if (st1b.eq.YO) then              if (st1b.eq.YO) then
188                 ke = 1                                   ke = 1                  
189                 m = ic                 m = ic
190                 do i = 1, 20000                 call riempi(m,lunga,lleng,lung,pari,vect,vecta)
                   vect(i) = 0  
                   do bit=0, 7  
                      bi = ibits(vecta(m+1),bit,1)  
                      if (bi.eq.1) vect(i) = ibset(vect(i),bit)  
                      bi = ibits(vecta(m),bit,1)  
                      if (bi.eq.1) vect(i) = ibset(vect(i),bit+8)  
                   enddo          
                   m = m + 2  
                enddo  
191                 icb = 1                 icb = 1
192                 if (st2b.ne.0) then                 if (st2b.ne.0) then
193                    E2(contr) = vect(icb)                    E2(contr) = vect(icb)
# Line 203  c Line 211  c
211              if (st1b.eq.XE) then              if (st1b.eq.XE) then
212                 ke = 1                 ke = 1
213                 m = ic                 m = ic
214                 do i = 1, 20000                 call riempi(m,lunga,lleng,lung,pari,vect,vecta)
                   vect(i) = 0  
                   do bit=0, 7  
                      bi = ibits(vecta(m+1),bit,1)  
                      if (bi.eq.1) vect(i) = ibset(vect(i),bit)  
                      bi = ibits(vecta(m),bit,1)  
                      if (bi.eq.1) vect(i) = ibset(vect(i),bit+8)  
                   enddo          
                   m = m + 2  
                enddo  
215                 icb = 1                 icb = 1
216                 if (st2b.ne.0) then                 if (st2b.ne.0) then
217                    E2(contr) = vect(icb)                    E2(contr) = vect(icb)
# Line 236  c Line 235  c
235              if (st1b.eq.XO) then              if (st1b.eq.XO) then
236                 ke = 1                 ke = 1
237                 m = ic                 m = ic
238                 do i = 1, 20000                 call riempi(m,lunga,lleng,lung,pari,vect,vecta)
                   vect(i) = 0  
                   do bit=0, 7  
                      bi = ibits(vecta(m+1),bit,1)  
                      if (bi.eq.1) vect(i) = ibset(vect(i),bit)  
                      bi = ibits(vecta(m),bit,1)  
                      if (bi.eq.1) vect(i) = ibset(vect(i),bit+8)  
                   enddo          
                   m = m + 2  
                enddo  
239                 icb = 1                 icb = 1
240                 if (st2b.ne.0) then                 if (st2b.ne.0) then
241                    E2(contr) = vect(icb)                    E2(contr) = vect(icb)
# Line 268  c Line 258  c
258  c  c
259  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
260  c      c    
261           if (ic.gt.39999) then           if (ic.gt.(lung-1)) then
262              error(contr) = 130              error(contr) = 130
263              if (contr.ne.1) contr=5              if (contr.ne.1) contr=5
264              me = 1              me = 1
# Line 288  C Line 278  C
278           icb = icb + 1           icb = icb + 1
279           length = vect(icb) + 2           length = vect(icb) + 2
280           length2 = vect(icb)           length2 = vect(icb)
281             lleng = (length * 2) - 1
282  C  C
283  C Check validity of length.  C Check validity of length.
284  C  C
# Line 356  C Line 347  C
347           contr=1                 contr=1      
348        endif        endif
349  C  C
350          do l = 1, 4
351             do bit=0, 31
352                if (bit.lt.16) then
353                   bi = ibits(E2(L),bit,1)
354                else
355                   bi = 0
356                endif
357                if (bi.eq.1) stwerr(l) = ibset(stwerr(l),bit)
358             enddo
359             perror(l) = float(error(l))
360          enddo
361    C
362          if (me.eq.0) iev2 = iev2 + 1
363        RETURN        RETURN
364        END        END
365    
Legend:
Removed from v.1.6  
changed lines
  Added in v.1.7
  ViewVC Help
Powered by ViewVC 1.1.23