/[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.2 by kusanagi, Tue Jul 6 14:04:06 2004 UTC revision 1.3 by kusanagi, Tue Jul 6 14:07:30 2004 UTC
# Line 1  Line 1 
1    
2  C------------------------------------------------  C------------------------------------------------
3        SUBROUTINE CALPULSE(vect,ERROR,CAL_PULSE)  c      SUBROUTINE CALPULSE(vect,ERROR,calpulse,CONTR,e2)
4  C------------------------------------------------        SUBROUTINE CALPULSE(vect,lung,me)
5    C------------------------------------------------
6        IMPLICIT NONE  
7  C        IMPLICIT NONE
8  C Normal variables definition  C
9  C  C Normal variables definition
10        INTEGER ERROR  C
11  C        INTEGER ERROR(4)
12        INTEGER i, j, ival  C
13  C        INTEGER i, j, iev,iev2, lung, me
14        INTEGER*2 VECT(20000)        INTEGER NPLA, NCHA, LENSEV
15  C        PARAMETER (NPLA=22,NCHA=96,LENSEV=NPLA*NCHA)
16        integer*2 check, crc  C
17  C        INTEGER*2 VECT(20000)
18        INTEGER ic, k, ke  C
19        INTEGER status        integer*2 check, crc,e2(4)
20        INTEGER inf, sup  C
21        INTEGER XO, YO, XE, YE        INTEGER ic, k, ke, ic0
22          INTEGER status, CONTR
23          INTEGER inf, sup
24        INTEGER*2 length, length2        INTEGER XO, YO, XE, YE
25    
26        INTEGER*2 st1, st2  
27          INTEGER*2 length, length2
28        REAL CAL_PULSE(4,11,96),  
29          INTEGER*2 st1, st2
30        DATA XO/177/ ! CODE_DSP_R XO = 101 10001  
31        DATA YO/173/ ! CODE_DSP_R YO = 101 01101        REAL calpuls(4,11,96)
32        DATA XE/170/ ! CODE_DSP_R XE = 101 01010  
33        DATA YE/182/ ! CODE_DSP_R YE = 101 10110        DATA XO/177/ ! CODE_DSP_R XO = 101 10001
34          DATA YO/173/ ! CODE_DSP_R YO = 101 01101
35  C                DATA XE/170/ ! CODE_DSP_R XE = 101 01010
36  C Begin !        DATA YE/182/ ! CODE_DSP_R YE = 101 10110
37  C  
38        ERROR = 0        REAL calped(4,11,96), calgood(4,11,96), calthr(4,11,6)
39        ival = 0        REAL calrms(4,11,96), calbase(4,11,6), calvar(4,11,6)
40  C  
41        ic = 0        real calselftrig(4,7), calIItrig(4), calstripshit(4)
42  c        real calDSPtaberr(4), calevnum(4)
43        length = ic        REAL DEXY(2,NPLA,NCHA), dexyc(2,npla,ncha), base(2,npla,ncha)
44        do k = 1,4  
45           ic = ic + length + 1        COMMON / evento / IEV,
46           ke = 0       &     dexy,dexyc,base,
47           do while (ke = 0)       &     calselftrig,calIItrig,
48  C       &     calstripshit,calDSPtaberr,calevnum
49  C Check consistency of status word.        
50  C        save / evento /
51              st1 = IAND(vect(ic),'00FF'x)  
52              if (st1.ne.0) then        COMMON / calib / IEV2, calped, calgood, calthr, calrms,
53                 write (*,10) k,vect(ic)       &     calbase,
54              endif       &     calvar,
55              st2 = IAND(vect(ic),'FF00'x)       &     calpuls
56              status = ISHFT(st2,-8)  
57  C        save / calib /
58              if (k.eq.1) then  
59                 if (status.eq.YE) then        COMMON /VARIE/error, CONTR, E2
60                    ke = 1        SAVE /VARIE/
61                 else      
62                    write (*,11) k,vect(ic)  
63                    ERROR = 1  C        
64                 endif  C Begin !
65                 if (status.eq.YO.or.status.eq.XE.or.status.eq.XO) then  C
66                    write (*,12) k        me = 0
67                    length = -1        ic = 0
68                    goto 50  c
69                 endif                      length = ic
70              endif  c
71  C               20   continue
72              if (k.eq.2) then        ic = ic + length + 1
73                 if (status.eq.YO) then        ke = 0
74                    ke = 1        do while (ke.eq.0)
75                 else  C
76                    write (*,11) k,vect(ic)  C Check consistency of header.
77                    ERROR = 1  C it is composed by CODE+D# (8 bits) and by SATUS WORD (8 bits)
78                 endif  c so we must split vect into the two components:
79                 if (status.eq.YE.or.status.eq.XE.or.status.eq.XO) then  C
80                    write (*,12) k  C ST1 is CODE + D#
81                    length = -1           status = ISHFT(vect(ic),-8)
82                    goto 50           st1 = IAND(status,'00FF'x)
83                 endif                C ST2 is the STATUS WORD
84              endif           st2 = IAND(vect(ic),'00FF'x)
85  C  c    
86              if (k.eq.3) then           e2(contr) = 0
87                 if (status.eq.XE) then  C
88                    ke = 1           if (contr.eq.1) then
89                 else              if (st1.eq.YE) then
90                    write (*,11) k,vect(ic)                 ke = 1
91                    ERROR = 1                 if (st2.ne.0) then
92                 endif                    E2(contr) = vect(ic)
93                 if (status.eq.XO.or.status.eq.YO.or.status.eq.YE) then                 endif
94                    write (*,12) k              else
95                    length = -1                 if (st1.eq.YO.or.st1.eq.XE.or.st1.eq.XO) THEN
96                    goto 50                    error(contr) = 129
97                 endif                                  contr = 2
98              endif                    length = -1
99  C                    goto 20
100              if (k.eq.4) then                 ELSE
101                 if (status.eq.XO) then                    ERROR(contr) = 128
102                    ke = 1                    GOTO 100
103                 else                 endif
104                    write (*,11) k,vect(ic)              endif
105                    ERROR = 1           ENDIF
106                 endif  C            
107              endif           if (CONTR.eq.2) then
108  C              if (st1.eq.YO) then
109              ic = ic + 1                 ke = 1                  
110              if (ic.gt.20000) then                 if (st2.ne.0) then
111                 write (*,13)                    E2(contr) = vect(ic)
112                 ERROR = 1                 endif
113                 goto 100              else
114              endif                 if (st1.eq.XE.or.st1.eq.XO) then
115           enddo                    error(contr) = 129
116  C                                  contr = 3
117   10      FORMAT(2X,'Error for view:',2X,I1,2X,'Status word:',2X,Z4)                    length = -1
118   11      FORMAT(2X,'View or command not recognized for view:',2X,I1,2X,                    goto 20
119       &        'Status word:',2X,Z4)                 ELSE
120   12      FORMAT(2X,'Error - did NOT find view:',2X,I1)                    ERROR(contr) = 128
121   13      FORMAT(2X,'Error - eof reached, exiting')                    GOTO 100
122  C                 endif
123  C         ic = ic + 1              endif
124           length = length + (vect(ic) + 2)           ENDIF
125           length2 = vect(ic)  C    
126  C           if (CONTR.eq.3) then
127  C Check validity of length.              if (st1.eq.XE) then
128  C                 ke = 1
129           if (vect(ic).ne.1057) then                 if (st2.ne.0) then
130              print *,'problems with view',k                    E2(contr) = vect(ic)
131              ERROR = 1                 endif
132              goto 50              else
133           endif                 if (st1.eq.XO) then
134  C                    error(contr) = 129
135  C Check consistency of CRC.                    contr = 4
136  C                    length = -1
137           check = 0.                    goto 20
138           inf = (length-length2-2)+1                 ELSE
139           sup = length - 1                    ERROR(contr) = 128              
140           do i = inf,sup                    GOTO 100
141              check=crc(check,vect(i))                 endif
142           enddo              endif
143           if (check.ne.vect(length)) then           ENDIF
144              print *,'Problems with CRC of view:',k  C
145              ERROR = 1           if (CONTR.eq.4) then
146              goto 50              if (st1.eq.XO) then
147           endif                 ke = 1
148  C                 if (st2.ne.0) then
149  C Process data.                    E2(contr) = vect(ic)
150  C                 endif
151           do j = 1,96              else
152              do i = 1,11                 ERROR(contr) = 128
153                 ic = ic + 1                 GOTO 100
154                 cal_pulse(k,i,j) = vect(ic)              endif  
155              enddo           endif
156           enddo  C    
157  c   100     CONTINUE
158   50      continue           ic = ic + 1
159  c           if (ic.gt.20000) then
160        enddo              ERROR(contr) = 130
161  C              if (contr.ne.1) contr=5
162   100  continue              me = 1
163  C              goto 200
164        RETURN           endif
165        END        enddo
166    C              
167     10      FORMAT(2X,'Error for view:',2X,I1,2X,'Status word:',2X,Z4)
168     11      FORMAT(2X,'View or command not recognized for view:',2X,I1,2X,
169         &        'Status word:',2X,Z4)
170     12      FORMAT(2X,'Error - did NOT find view:',2X,I1)
171     13      FORMAT(2X,'Error - eof reached, exiting')
172    C
173             K = CONTR
174             ic0 = ic - 1
175             length = ic0 + vect(ic) + 1
176             length2 = vect(ic)
177    C
178    C Check validity of length.
179    C
180             if (vect(ic).ne.1057) then
181                ERROR(contr) = 131
182                me = 1
183                goto 200
184             endif
185    C
186    C Check consistency of CRC.
187    C
188             check = 0.
189             inf = ic0
190             sup = length - 1
191             do i = inf,sup
192                check=crc(check,vect(i))
193             enddo
194             if (check.ne.vect(length)) then
195                ERROR(contr) = 132
196                me = 1
197                goto 200
198             endif
199    C
200    C Process data.
201    C
202             do j = 1,96
203                do i = 1,11
204                   ic = ic + 1
205                   calpuls(k,i,j) = vect(ic)
206               enddo
207             enddo
208             CONTR = contr + 1
209             me = 0
210    c  
211             if (contr.eq.5) contr = 1
212    c
213     50      continue
214    c
215    C    
216     200  continue
217    C
218          if (error(1).eq.129.and.error(2).eq.129
219         &     .and.error(3).eq.129.and.error(4).eq.130) then
220             call vzero(error,4)
221             me = 1
222             contr=1      
223          endif
224    C
225          RETURN
226          END
227    
228    
Legend:
Removed from v.1.2  
changed lines
  Added in v.1.3
  ViewVC Help
Powered by ViewVC 1.1.23