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

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

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.4 - (hide annotations) (download)
Thu Jul 8 13:05:26 2004 UTC (20 years, 5 months ago) by kusanagi
Branch: MAIN
Changes since 1.3: +0 -0 lines
FILE REMOVED
*** empty log message ***

1 kusanagi 1.3
2     C------------------------------------------------
3     c SUBROUTINE CALPULSE(vect,ERROR,calpulse,CONTR,e2)
4     SUBROUTINE CALPULSE(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 i, j, iev,iev2, lung, me
14     INTEGER NPLA, NCHA, LENSEV
15     PARAMETER (NPLA=22,NCHA=96,LENSEV=NPLA*NCHA)
16     C
17     INTEGER*2 VECT(20000)
18     C
19     integer*2 check, crc,e2(4)
20     C
21     INTEGER ic, k, ke, ic0
22     INTEGER status, CONTR
23     INTEGER inf, sup
24     INTEGER XO, YO, XE, YE
25    
26    
27     INTEGER*2 length, length2
28    
29     INTEGER*2 st1, st2
30    
31     REAL calpuls(4,11,96)
32    
33     DATA XO/177/ ! CODE_DSP_R XO = 101 10001
34     DATA YO/173/ ! CODE_DSP_R YO = 101 01101
35     DATA XE/170/ ! CODE_DSP_R XE = 101 01010
36     DATA YE/182/ ! CODE_DSP_R YE = 101 10110
37    
38     REAL calped(4,11,96), calgood(4,11,96), calthr(4,11,6)
39     REAL calrms(4,11,96), calbase(4,11,6), calvar(4,11,6)
40    
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     me = 0
67     ic = 0
68     c
69     length = ic
70     c
71     20 continue
72     ic = ic + length + 1
73     ke = 0
74     do while (ke.eq.0)
75     C
76     C Check consistency of header.
77     C it is composed by CODE+D# (8 bits) and by SATUS WORD (8 bits)
78     c so we must split vect into the two components:
79     C
80     C ST1 is CODE + D#
81     status = ISHFT(vect(ic),-8)
82     st1 = IAND(status,'00FF'x)
83     C ST2 is the STATUS WORD
84     st2 = IAND(vect(ic),'00FF'x)
85     c
86     e2(contr) = 0
87     C
88     if (contr.eq.1) then
89     if (st1.eq.YE) then
90     ke = 1
91     if (st2.ne.0) then
92     E2(contr) = vect(ic)
93     endif
94     else
95     if (st1.eq.YO.or.st1.eq.XE.or.st1.eq.XO) THEN
96     error(contr) = 129
97     contr = 2
98     length = -1
99     goto 20
100     ELSE
101     ERROR(contr) = 128
102     GOTO 100
103     endif
104     endif
105     ENDIF
106     C
107     if (CONTR.eq.2) then
108     if (st1.eq.YO) then
109     ke = 1
110     if (st2.ne.0) then
111     E2(contr) = vect(ic)
112     endif
113     else
114     if (st1.eq.XE.or.st1.eq.XO) then
115     error(contr) = 129
116     contr = 3
117     length = -1
118     goto 20
119     ELSE
120     ERROR(contr) = 128
121     GOTO 100
122     endif
123     endif
124     ENDIF
125     C
126     if (CONTR.eq.3) then
127     if (st1.eq.XE) then
128     ke = 1
129     if (st2.ne.0) then
130     E2(contr) = vect(ic)
131     endif
132     else
133     if (st1.eq.XO) then
134     error(contr) = 129
135     contr = 4
136     length = -1
137     goto 20
138     ELSE
139     ERROR(contr) = 128
140     GOTO 100
141     endif
142     endif
143     ENDIF
144     C
145     if (CONTR.eq.4) then
146     if (st1.eq.XO) then
147     ke = 1
148     if (st2.ne.0) then
149     E2(contr) = vect(ic)
150     endif
151     else
152     ERROR(contr) = 128
153     GOTO 100
154     endif
155     endif
156     C
157     100 CONTINUE
158     ic = ic + 1
159     if (ic.gt.20000) then
160     ERROR(contr) = 130
161     if (contr.ne.1) contr=5
162     me = 1
163     goto 200
164     endif
165     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    

  ViewVC Help
Powered by ViewVC 1.1.23