/[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.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: +11 -9 lines
*** 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 kusanagi 1.5 c ic = ic + length + 1
73     ic = length + 1
74     32 continue
75 kusanagi 1.3 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     if (st1.eq.YO.or.st1.eq.XE.or.st1.eq.XO) THEN
98     error(contr) = 129
99     contr = 2
100 kusanagi 1.5 c length = -1
101     goto 32
102 kusanagi 1.3 ELSE
103     ERROR(contr) = 128
104     GOTO 100
105     endif
106     endif
107     ENDIF
108     C
109     if (CONTR.eq.2) then
110     if (st1.eq.YO) then
111     ke = 1
112     if (st2.ne.0) then
113     E2(contr) = vect(ic)
114     endif
115     else
116     if (st1.eq.XE.or.st1.eq.XO) then
117     error(contr) = 129
118     contr = 3
119 kusanagi 1.5 c length = -1
120     goto 32
121 kusanagi 1.3 ELSE
122     ERROR(contr) = 128
123     GOTO 100
124     endif
125     endif
126     ENDIF
127     C
128     if (CONTR.eq.3) then
129     if (st1.eq.XE) then
130     ke = 1
131     if (st2.ne.0) then
132     E2(contr) = vect(ic)
133     endif
134     else
135     if (st1.eq.XO) then
136     error(contr) = 129
137     contr = 4
138 kusanagi 1.5 c length = -1
139     goto 32
140 kusanagi 1.3 ELSE
141     ERROR(contr) = 128
142     GOTO 100
143     endif
144     endif
145     ENDIF
146     C
147     if (CONTR.eq.4) then
148     if (st1.eq.XO) then
149     ke = 1
150     if (st2.ne.0) then
151     E2(contr) = vect(ic)
152     endif
153     else
154     ERROR(contr) = 128
155     GOTO 100
156     endif
157     endif
158     C
159     100 CONTINUE
160     ic = ic + 1
161 kusanagi 1.5 if (ic.gt.19999) then
162 kusanagi 1.3 ERROR(contr) = 130
163     if (contr.ne.1) contr=5
164     me = 1
165     goto 200
166     endif
167     enddo
168     C
169     10 FORMAT(2X,'Error for view:',2X,I1,2X,'Status word:',2X,Z4)
170     11 FORMAT(2X,'View or command not recognized for view:',2X,I1,2X,
171     & 'Status word:',2X,Z4)
172     12 FORMAT(2X,'Error - did NOT find view:',2X,I1)
173     13 FORMAT(2X,'Error - eof reached, exiting')
174     C
175     K = CONTR
176     ic0 = ic - 1
177     length = ic0 + vect(ic) + 1
178     length2 = vect(ic)
179     C
180     C Check validity of length.
181     C
182     if (vect(ic).ne.1057) then
183     ERROR(contr) = 131
184     me = 1
185     goto 200
186     endif
187     C
188     C Check consistency of CRC.
189     C
190     check = 0.
191     inf = ic0
192     sup = length - 1
193     do i = inf,sup
194     check=crc(check,vect(i))
195     enddo
196     if (check.ne.vect(length)) then
197     ERROR(contr) = 132
198     me = 1
199     goto 200
200     endif
201     C
202     C Process data.
203     C
204     do j = 1,96
205     do i = 1,11
206     ic = ic + 1
207     calpuls(k,i,j) = vect(ic)
208     enddo
209     enddo
210     CONTR = contr + 1
211     me = 0
212     c
213     if (contr.eq.5) contr = 1
214     c
215     50 continue
216     c
217     C
218     200 continue
219     C
220     if (error(1).eq.129.and.error(2).eq.129
221     & .and.error(3).eq.129.and.error(4).eq.130) then
222 kusanagi 1.5 call azero(error,4)
223 kusanagi 1.3 me = 1
224     contr=1
225     endif
226     C
227     RETURN
228     END
229    
230    

  ViewVC Help
Powered by ViewVC 1.1.23