/[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.5 - (hide annotations) (download)
Thu Jul 8 13:06:45 2004 UTC (20 years, 5 months ago) by kusanagi
Branch: MAIN
Changes since 1.4: +12 -9 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 kusanagi 1.5 c ic = ic + length + 1
75     ic = length + 1
76     32 continue
77 kusanagi 1.3 ke = 0
78 kusanagi 1.5 c PRINT *,'cia'
79 kusanagi 1.3 do while (ke.eq.0)
80     C
81     C Check consistency of header.
82     C it is composed by CODE+D# (8 bits) and by SATUS WORD (8 bits)
83     c so we must split vect into the two components:
84     C
85     C ST1 is CODE + D#
86     status = ISHFT(vect(ic),-8)
87     st1 = IAND(status,'00FF'x)
88     C ST2 is the STATUS WORD
89     st2 = IAND(vect(ic),'00FF'x)
90     c
91     e2(contr) = 0
92     C
93     if (contr.eq.1) then
94     if (st1.eq.YE) then
95     ke = 1
96     if (st2.ne.0) then
97     E2(contr) = vect(ic)
98     endif
99     else
100     c
101     if (st1.eq.YO.or.st1.eq.XE.or.st1.eq.XO) THEN
102     error(contr) = 129
103     contr = 2
104 kusanagi 1.5 c length = -1
105     goto 32
106 kusanagi 1.3 ELSE
107     ERROR(contr) = 128
108     GOTO 100
109     endif
110     endif
111     ENDIF
112     C
113     if (CONTR.eq.2) then
114     if (st1.eq.YO) then
115     ke = 1
116     if (st2.ne.0) then
117     E2(contr) = vect(ic)
118     endif
119     else
120     if (st1.eq.XE.or.st1.eq.XO) then
121     error(contr) = 129
122     contr = 3
123 kusanagi 1.5 c length = -1
124     goto 32
125 kusanagi 1.3 ELSE
126     ERROR(contr) = 128
127     GOTO 100
128     endif
129     endif
130     ENDIF
131     C
132     if (CONTR.eq.3) then
133     if (st1.eq.XE) then
134     ke = 1
135     if (st2.ne.0) then
136     E2(contr) = vect(ic)
137     endif
138     else
139     if (st1.eq.XO) then
140     error(contr) = 129
141     contr = 4
142 kusanagi 1.5 c length = -1
143     goto 32
144 kusanagi 1.3 ELSE
145     ERROR(contr) = 128
146     GOTO 100
147     endif
148     endif
149     ENDIF
150     C
151     if (CONTR.eq.4) then
152     if (st1.eq.XO) then
153     ke = 1
154     if (st2.ne.0) then
155     E2(contr) = vect(ic)
156     endif
157     else
158     ERROR(contr) = 128
159     GOTO 100
160     endif
161     endif
162     C
163     100 CONTINUE
164     ic = ic + 1
165 kusanagi 1.5 if (ic.gt.19999) then
166 kusanagi 1.3 ERROR(contr) = 130
167     if (contr.ne.1) contr=5
168     me = 1
169     goto 200
170     endif
171     enddo
172     C
173     10 FORMAT(2X,'Error for view:',2X,I1,2X,'Status word:',2X,Z4)
174     11 FORMAT(2X,'View or command not recognized for view:',2X,I1,2X,
175     & 'Status word:',2X,Z4)
176     12 FORMAT(2X,'Error - did NOT find view:',2X,I1)
177     13 FORMAT(2X,'Error - eov reached, exiting')
178     101 FORMAT(2X,'Status word 1:',2X,Z8)
179     201 FORMAT(2X,'Status word 2:',2X,Z8)
180     C
181     K = CONTR
182     ic0 = ic - 1
183     length = ic0 + vect(ic) + 1
184     length2 = vect(ic)
185     C
186     C Check validity of length.
187     C
188     if (vect(ic).ne.4629) then
189     ERROR(contr) = 131
190     me = 1
191     goto 200
192     endif
193     C
194     C Check consistency of CRC.
195     C
196     check = 0.
197     inf = ic0
198     sup = length - 1
199     do i = inf,sup
200     check=crc(check,vect(i))
201     enddo
202     if (check.ne.vect(length)) then
203     ERROR(contr) = 132
204     me = 1
205     goto 200
206     endif
207     C
208     C Process data.
209     C
210     do i = 1,11
211     do j = 1,96
212     ic = ic + 1
213     calped(k,i,j) = vect(ic)
214     calgood(k,i,j) = vect(ic+1)
215     ic = ic + 1
216     enddo
217     enddo
218     C
219     ic = ic + 4
220     do i = 1,11
221     do j = 1,6
222     ic = ic + 1
223     calthr(k,i,j) = vect(ic)
224     ic = ic + 1
225     enddo
226     enddo
227    
228     c
229     ic = ic + 4
230     do i = 1,11
231     do j = 1,96
232     ic = ic + 1
233     calrms(k,i,j) = vect(ic)
234     ic = ic + 1
235     enddo
236     enddo
237     c'
238     do i = 1,11
239     do j = 1,6
240     ic = ic + 1
241     calbase(k,i,j) = vect(ic)
242     ic = ic + 1
243     ic = ic + 1
244     calvar(k,i,j) = vect(ic)
245     ic = ic + 1
246     enddo
247     enddo
248     CONTR = CONTR + 1
249     me = 0
250     c
251     if (contr.eq.5) contr = 1
252     c
253     50 continue
254     C
255     200 continue
256     if (error(1).eq.129.and.error(2).eq.129
257     & .and.error(3).eq.129.and.error(4).eq.130) then
258 kusanagi 1.5 call azero(error,4)
259 kusanagi 1.3 contr=1
260     me = 1
261     endif
262     C
263     RETURN
264     END
265    
266    

  ViewVC Help
Powered by ViewVC 1.1.23