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

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

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.3 - (hide annotations) (download)
Tue Jul 6 14:07:30 2004 UTC (20 years, 5 months ago) by kusanagi
Branch: MAIN
Changes since 1.2: +263 -199 lines
*** empty log message ***

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

  ViewVC Help
Powered by ViewVC 1.1.23