/[PAMELA software]/calo/unpacking/data2ntp.for
ViewVC logotype

Contents of /calo/unpacking/data2ntp.for

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.1.1.1 - (show annotations) (download) (vendor branch)
Mon Dec 5 16:23:21 2005 UTC (18 years, 11 months ago) by mocchiut
Branch: MAIN, unpacking
CVS Tags: start, v1r00, HEAD
Changes since 1.1: +0 -0 lines
Imported sources

1 C------------------------------------------------
2 PROGRAM DATA2NTP
3 C------------------------------------------------
4
5 IMPLICIT NONE
6 C
7 CHARACTER*40 file
8 CHARACTER*9 cho
9 CHARACTER*1 ANSW
10 CHARACTER*40 file_name3
11
12 C
13 INTEGER NPLA, NCHA, LENSEV
14 PARAMETER (NPLA=22,NCHA=96,LENSEV=NPLA*NCHA)
15
16 integer vai, inizio, kl
17 integer numev, lung, me
18 integer*1 mah
19 integer*4 evnum, systime, len
20 integer RUNERROR, PERR(4), NERROR, merror(4)
21 C
22 C Normal variables definition
23 C
24 INTEGER FFD, est1, est2, lu1, lu,lu2,lu3
25 C
26 INTEGER i, j, kk, ival, silofa, p,ik
27 INTEGER istat, ierr, icycle, bi, bit
28 C
29 INTEGER*2 VECT(20000), estatus
30 INTEGER*4 st3, word1
31 c
32 integer*1 vecta(40000), vectb(40000),word(3), savewo(3)
33 C
34 integer*8 buffer(2), obt1,obt2,obt3,obt4,obt,obtold
35 integer calcrc, vet,vec
36 C
37 integer*2 check, crc, stwer(4)
38 C
39 INTEGER ic, k, l, fake
40 INTEGER status, CONTR
41 INTEGER inf, sup
42
43 integer dst1, dst2
44 integer*1 dstatus
45
46 INTEGER*2 length, length2
47
48 INTEGER lundata, iosop
49 INTEGER*2 st1, st2, st4
50
51 INTEGER lrec
52 PARAMETER (lrec=8190)
53
54 integer irec,iev,iev2, iev3
55
56 real RVECT(50)
57 REAL calped(4,11,96), calgood(4,11,96), calthr(4,11,6)
58 REAL calrms(4,11,96), calbase(4,11,6), calvar(4,11,6)
59 REAL calpuls(4,11,96)
60 real calselftrig(4,7), calIItrig(4), calstriphit(4)
61 real calDSPtaberr(4), calevnum(4)
62 REAL DEXY(2,NPLA,NCHA), dexyc(2,npla,ncha), base(2,npla,6)
63 real perror(4), cperror(4)
64 real pperror(4)
65 integer pstwerr(4)
66 integer cstwerr(4)
67 integer stwerr(4)
68 integer dump, fat
69
70 integer calev0, oldcalev0, calev1,oldcalev1,calevv2,
71 & oldcalev2,calev3,oldcalev3
72
73 COMMON / evento / IEV, stwerr, perror,
74 & dexy,dexyc,base,
75 & calselftrig,calIItrig,
76 & calstriphit,calDSPtaberr,calevnum
77
78 save / evento /
79
80 COMMON / calib / IEV2, cstwerr, cperror,
81 & calped, calgood, calthr, calrms,
82 & calbase,
83 & calvar
84
85 save / calib /
86
87 COMMON / calpul / IEV3, pstwerr, pperror,
88 & calpuls
89
90 save / calpul /
91
92 c
93 COMMON / VARIE / dump, CONTR, merror
94 SAVE / VARIE /
95
96 COMMON / HEADER / buffer
97 SAVE / HEADER /
98
99 REAL hmemor(9000000)
100 integer Iquest(100)
101 COMMON /pawc/hmemor
102 Common /QUEST/ Iquest
103
104 CALL HLIMIT(9000000)
105
106 Iquest(10) = 256000
107 c Iquest(10) = 128000
108
109 calev0=0;
110 calev1=0;
111 calevv2=0;
112 calev3=0;
113 C
114 C Begin !
115 C
116 C
117 PRINT *,'File to save? '
118 READ(*,904)file_name3
119 print *,file_name3
120 C
121 C Histos creation
122 C
123 CALL HROPEN(59,'Event','/wizard3/pamela/integr/'//
124 + file_name3,'nqe',lrec,istat)
125 CALL HBNT(1,'Pamela Calo',' ')
126 CALL HBNT(2,'Pamela data',' ')
127 CALL HBNT(3,'Pamela puls',' ')
128 CALL HBSET('BSIZE',lrec,ierr)
129
130 *** /* Book ntuple variables */
131 CALL HBNAME(1,'calib',iev2,'iev2:I,cstwerr(4):I,cperror(4):R,'//
132 & 'calped(4,11,96):R,'//
133 & 'calgood(4,11,96):R,calthr(4,11,6):R,'//
134 & 'calrms(4,11,96):R,calbase(4,11,6):R,calvar(4,11,6)')
135 CALL HBNAME(2,'evento',iev,'iev:I,stwerr(4):I,perror(4):R,'//
136 & 'dexy(2,22,96):R,'//
137 & 'dexyc(2,22,96):R,base(2,22,6):R,'//
138 & 'calselftrig(4,7):R,'//
139 & 'calIItrig(4):R,'//
140 & 'calstriphit(4):R,calDSPtaberr(4):R,calevnum(4):R')
141 CALL HBNAME(3,'calpul',iev3,'iev3:I,pstwerr(4):I,pperror(4):R,'//
142 & 'calpuls(4,11,96):R')
143 C
144 iev = 0
145 iev2 = 0
146 iev3 = 0
147 c
148 7 continue
149 RUNERROR=0 ! error variable
150
151 PRINT *,'File to read? '
152 READ(*,905)file
153 print *,file
154
155 numev = 0
156 PRINT *,'Number of fafede? '
157 READ(*,906)numev
158 print *,numev
159 numev = numev + 1
160
161 inizio = 1
162 PRINT *,'Where to start? '
163 READ(*,906)inizio
164 print *,inizio
165
166 906 FORMAT(I6)
167 905 FORMAT(A40)
168 c
169 lundata = 44
170 c
171 OPEN(UNIT=lundata,FILE='/wizard3/pamela/integr/'//file
172 & ,STATUS='OLD', FORM='UNFORMATTED',ACCESS='DIRECT',ERR=50
173 & ,recl=4)
174 C
175 PRINT *,'Data, pedestal, pulse or all? '
176 READ(*,903)cho
177 print *,cho
178 C
179 dump = -1
180 PRINT *,'Any iev to be dumped out (number/[-1])? '
181 READ(*,906)dump
182 print *,dump
183 if (dump.ne.-1) dump = dump - 1
184 c
185 fat = 39312
186 PRINT *,'Any fafede type (i.e. 10,07,18,..) to be dumped'//
187 & ' out (number/[-1])? '
188 READ(*,29)fat
189 write(*,29)fat
190 29 format(Z4)
191 C
192 903 FORMAT(A9)
193 904 FORMAT(A40)
194 C
195 ffd=FNum(lundata) ! take the file descriptor number
196 C
197 contr = 1
198 call azero(calped,4*11*96)
199 call azero(calgood,4*11*96)
200 call azero(calthr,4*11*96)
201 call azero(calrms,4*11*96)
202 call azero(calbase,4*11*6)
203 call azero(calvar,4*11*6)
204 call azero(calpuls,4*11*96)
205 call azero(dexy,4*11*96)
206 call azero(dexyc,4*11*96)
207 call azero(base,4*11*6)
208 call azero(calselftrig,4*7)
209 call azero(calIItrig,4)
210 call azero(calstriphit,4)
211 call azero(calDSPtaberr,4)
212 call azero(calevnum,4)
213 c
214 obt = 0
215 obtold = 0
216 do l = 1,4
217 stwer(l) = 0
218 perr(l) = 0
219 cstwerr(l) = 0
220 cperror(l) = 0.
221 pstwerr(l) = 0
222 pperror(l) = 0.
223 stwerr(l) = 0
224 perror(l) = 0.
225 enddo
226 C
227 C Read event: use C readevent routine, it reads words of 32 bits
228 C search the first FAFEDE of the file:
229 C
230 do p=1,20000
231 vect(p) = 0
232 enddo
233 silofa = 0
234 word(1) = 0
235 word(2) = 0
236 word(3) = 0
237 c
238 vai = 0
239 do while (vai.lt.inizio)
240 do i = 1, 3
241 fake = 0
242 runerror = 0
243 call reads(fake,runerror,ffd)
244 if (runerror.eq.-1.or.runerror.eq.1) then
245 print *,'Error reading file - no FAFEDE found!'
246 goto 50
247 endif
248 word(i) = fake
249 enddo
250 c
251 silofa = 0
252 do while (silofa.eq.0)
253 call fafede(word,silofa)
254 if (silofa.eq.1) then
255 savewo(1)=word(1)
256 savewo(2)=word(2)
257 savewo(3)=word(3)
258 vai = vai + 1
259 else
260 runerror = 0
261 fake = 0
262 call reads(fake,runerror,ffd)
263 word(1) = word(2)
264 word(2) = word(3)
265 word(3) = fake
266 endif
267 enddo
268 enddo
269 c
270 C ok, now for all the events search the next FAFEDE
271 c
272 do j = (inizio+1), numev
273 i = 0
274 lu = 39999
275 silofa = 0
276 c
277 i = i + 1
278 vecta(i) = savewo(1)
279 i = i + 1
280 vecta(i) = savewo(2)
281 i = i + 1
282 vecta(i) = savewo(3)
283 runerror = 0
284 fake = 0
285 word(1) = 0
286 word(2) = 0
287 word(3) = 0
288 do ik = 1, 3
289 call reads(fake,runerror,ffd)
290 if (runerror.eq.-1.or.runerror.eq.1) then
291 print *,'Error reading file - no FAFEDE found!'
292 goto 50
293 endif
294 word(ik) = fake
295 enddo
296 do while (silofa.eq.0)
297 c
298 c go out before running out of file!
299 c
300 if (j.ge.numev.and.i.ge.lu) then
301 silofa = 2
302 goto 77
303 endif
304 c
305 call fafede(word,silofa)
306 77 CONTINUE
307 if (silofa.eq.1) then
308 savewo(1)=word(1)
309 savewo(2)=word(2)
310 savewo(3)=word(3)
311 elseif (silofa.eq.0) then
312 call reads(fake,runerror,ffd)
313 i = i + 1
314 vecta(i) = word(1)
315 word(1) = word(2)
316 word(2) = word(3)
317 word(3) = fake
318 c
319 c extract length of the packet (first two bytes)
320 c
321 if (i.eq.13) then
322 lu1 = 0
323 do bit=0, 7
324 bi = ibits(vecta(i),bit,1)
325 if (bi.eq.1) then
326 lu1 = lu1 + 2**(bit+16)
327 endif
328 enddo
329 endif
330 if (i.eq.14) then
331 lu2 = 0
332 do bit=0, 7
333 bi = ibits(vecta(i),bit,1)
334 if (bi.eq.1) then
335 lu2 = lu2 + 2**(bit+8)
336 endif
337 enddo
338 endif
339 if (i.eq.15) then
340 108 format(2X,'numero ',2x,i5,2x,' valore ',2x,Z8)
341 109 format(2X,'i13-15 ',Z8)
342 lu3 = 0
343 do bit=0, 7
344 bi = ibits(vecta(i),bit,1)
345 if (bi.eq.1) then
346 lu3 = lu3 + 2**(bit)
347 endif
348 enddo
349 lu = (lu1 + lu2 + lu3) + 16
350 if (lu.lt.16) then
351 print *,'Warning: length ',lu
352 goto 9
353 endif
354 endif
355 c
356 c extract the OBT
357 c
358 if (i.eq.9) then
359 obt1 = 0
360 do bit=0, 7
361 bi = ibits(vecta(i),bit,1)
362 if (bi.eq.1) then
363 obt1 = obt1 + 2**(bit+32)
364 endif
365 enddo
366 endif
367 if (i.eq.10) then
368 obt2 = 0
369 do bit=0, 7
370 bi = ibits(vecta(i),bit,1)
371 if (bi.eq.1) then
372 obt2 = obt2 + 2**(bit+16)
373 endif
374 enddo
375 endif
376 if (i.eq.11) then
377 obt3 = 0
378 do bit=0, 7
379 bi = ibits(vecta(i),bit,1)
380 if (bi.eq.1) then
381 obt3 = obt3 + 2**(bit+8)
382 endif
383 enddo
384 endif
385 if (i.eq.12) then
386 obt4 = 0
387 do bit=0, 7
388 bi = ibits(vecta(i),bit,1)
389 if (bi.eq.1) then
390 obt4 = obt4 + 2**(bit)
391 endif
392 enddo
393 obtold = obt
394 obt = obt1 + obt2 + obt3 + obt4
395 endif
396 endif
397 enddo
398 C
399 c print *,'lunghezza i ',i
400 c print *,'lunghezza lu ',lu
401 c write(*,13)vecta(16)
402 if ( abs(obt-obtold).le.5 ) then
403 print *,''
404 print *,'WARNING1 OBT = ',obt,' OBT OLD = ',obtold
405 print *,''
406 endif
407 if ( (obt-obtold).lt.0 ) then
408 print *,''
409 print *,'WARNING2 OBT = ',obt,' OBT OLD = ',obtold
410 print *,''
411 endif
412 calcrc = 1
413 vec=-1
414 buffer(1) = 0
415 buffer(2) = 0
416 do vet=16,1,-1
417 vec = vec+1
418 if (vec.gt.7) then
419 do bit=0, 7
420 bi = 0
421 bi = ibits(vecta(vet),bit,1)
422 if (bi.eq.1) then
423 buffer(1)=ibset(buffer(1),bit+8*vec)
424 else
425 buffer(1)=ibclr(buffer(1),bit+8*vec)
426 endif
427 enddo
428 else
429 do bit=0, 7
430 bi = 0
431 bi = ibits(vecta(vet),bit,1)
432 if (bi.eq.1) then
433 buffer(2)=ibset(buffer(2),bit+8*vec)
434 else
435 buffer(2)=ibclr(buffer(2),bit+8*vec)
436 endif
437 enddo
438 endif
439 enddo
440 c write(*,14)buffer(1)
441 c write(*,14)buffer(2)
442 calcrc = 1
443 call testcrc(vecta(16),calcrc)
444 c print *,'calcrc ',calcrc
445 c
446 if (vecta(4).ne.vecta(5).or.calcrc.ne.0) then
447 print *,'Packet header corrupted!'
448 iev = iev + 1
449 goto 666
450 endif
451 if (i.lt.lu)
452 &print *,'WARNING packet length shorter than expected, CRC errors?'
453 c
454 if (lu.gt.40000) then
455 print *,'WARNING packet length problems, CRC errors?'
456 c
457 c goto 666
458 c
459 lu = i
460 endif
461 if (lu.gt.40000) then
462 c if (vecta(4).eq.24) iev=iev+1
463 c goto 666
464 lu = 40000
465 endif
466 c
467 do p = 1, 40000
468 vectb(p) = 0
469 if (p.gt.lu) then
470 vecta(p) = 0
471 continue
472 endif
473 if (p.gt.16) vectb(p-16)=vecta(p)
474 enddo
475 C
476 c write(*,28)fat,lu
477 c print *,' fat ',fat,' vecta(4) ',vecta(4)
478 if (vecta(4).eq.fat.or.fat.eq.39321.or.vecta(4).eq.-127) then
479 c if (vecta(4).eq.fat.or.fat.eq.153) then
480 c if (vecta(4).eq.fat.or.fat.eq.153.or.fat.eq.129) then
481 do l=1,lu
482 write(*,17)l,vecta(l)
483 17 FORMAT(2X,'Elemento:',2X,I6,2X,' word:',2X,Z8)
484 enddo
485 endif
486 c
487
488 print *,'############'
489 write(*,28)vecta(4),j-1,obt
490 print *,'############'
491 28 format(' # FAFEDE',Z2,' # pkt no ',I6,' OBT ',I16)
492 C
493 c
494 c do l=1,lu-18
495 c if ( vectb(l).ne.0 ) then
496 c if ( vectb(l).le.15.and.vectb(l).gt.0 ) then
497 c if ( vectb(l).eq.1 ) write(*,179)
498 c if ( vectb(l).eq.2 ) write(*,180)
499 c if ( vectb(l).eq.3 ) write(*,181)
500 c if ( vectb(l).eq.4 ) write(*,182)
501 c if ( vectb(l).eq.5 ) write(*,183)
502 c if ( vectb(l).eq.6 ) write(*,184)
503 c if ( vectb(l).eq.7 ) write(*,185)
504 c if ( vectb(l).eq.8 ) write(*,186)
505 c if ( vectb(l).eq.9 ) write(*,187)
506 c if ( vectb(l).eq.10 ) write(*,188)
507 c if ( vectb(l).eq.11 ) write(*,189)
508 c if ( vectb(l).eq.12 ) write(*,190)
509 c if ( vectb(l).eq.13 ) write(*,191)
510 c if ( vectb(l).eq.14 ) write(*,192)
511 c if ( vectb(l).eq.15 ) write(*,193)
512 c else
513 c write(*,177) vectb(l)
514 c endif
515 c else
516 c write(*,178)
517 c endif
518 c 177 FORMAT(Z2)
519 c 178 FORMAT('00')
520 c 179 FORMAT('01')
521 c 180 FORMAT('02')
522 c 181 FORMAT('03')
523 c 182 FORMAT('04')
524 c 183 FORMAT('05')
525 c 184 FORMAT('06')
526 c 185 FORMAT('07')
527 c 186 FORMAT('08')
528 c 187 FORMAT('09')
529 c 188 FORMAT('0A')
530 c 189 FORMAT('0B')
531 c 190 FORMAT('0C')
532 c 191 FORMAT('0D')
533 c 192 FORMAT('0E')
534 c 193 FORMAT('0F')
535 c enddo
536 c endif
537 c
538 if (cho.eq.'pulse'.or.cho.eq.'all') then
539 if (vecta(4).eq.8.or.vecta(4).eq.9) then
540 call calpulse(vectb,lu,me)
541 print *,'me = ',me
542 me = 0
543 do i = 1, 4
544 stwerr(i) = pstwerr(i)
545 perror(i) = pperror(i)
546 enddo
547 iev = iev3
548 else
549 me = 1
550 endif
551 endif
552 c
553 if (cho.eq.'pedestal'.or.cho.eq.'all') then
554 if (vecta(4).eq.24) then
555 call calpedestal(vectb,lu,me)
556 me = 0
557 do i = 1, 4
558 stwerr(i) = cstwerr(i)
559 perror(i) = cperror(i)
560 enddo
561 iev = iev2
562 else
563 me = 1
564 endif
565 endif
566 c
567 if (cho.eq.'data'.or.cho.eq.'all'.or.cho.eq.'debug') then
568 if (vecta(4).eq.16) then
569 call calunpack(vectb,lu,me)
570 me = 0
571 else
572 me = 1
573 call clearall
574 endif
575 endif
576 c
577 if (cho.eq.'house'.or.cho.eq.'all') then
578 if (vecta(4).eq.7) then
579 print *,'End of run!'
580 me = 0
581 endif
582 endif
583 c
584 if (me.eq.0) then
585 print *,'*****************************************************'
586 print *,' FAFEDE number: ',j-1
587 print *,'*****************************************************'
588 C
589 c iev = iev + 1
590 c iev2 = iev
591 do l = 1, 4
592 st4 = 0
593 st4 = IAND(stwerr(l),'00FF'x)
594 c if (st4.ne.0) then
595 write(*,112) l,stwerr(l)
596 do bit=0, 17
597 c bi = ibits(st4,bit,1)
598 bi = ibits(stwerr(l),bit,1)
599 if (bit.eq.0.and.bi.ne.0)
600 & print *,' ---> CRC error'
601 if (bit.eq.1.and.bi.ne.0)
602 & print *,' ---> Execution error'
603 if (bit.eq.2.and.bi.ne.0)
604 & print *,' ---> CMD length error'
605 if (bit.eq.3.and.bi.ne.0)
606 & print *,' ---> RAW mode'
607 if (bit.eq.4.and.bi.ne.0)
608 & print *,' ---> Latch up alarm'
609 if (bit.eq.5.and.bi.ne.0)
610 & print *,' ---> Temp. alarm'
611 if (bit.eq.6.and.bi.ne.0)
612 & print *,' ---> DSP ack error'
613 C
614 if (bit.eq.16.and.bi.ne.0)
615 & print *,' Acq. in compress mode, view: ',l
616 if (bit.eq.17.and.bi.ne.0)
617 & print *,' Acq. in full mode, view: ',l
618 C
619 enddo
620 112 format(1X,'View ',I1,' header: ',Z8)
621 c endif
622 if (perror(l).eq.128.)
623 & print *,'View or command not recognized, searching section',l
624 if (perror(l).eq.129.)
625 & print *,'Missing section ',l,' !'
626 if (perror(l).eq.130.)
627 & print *,'RAW MODE COMMAND! ',l
628 if (perror(l).eq.131.)
629 & print *,'--- Length problems! --- section ',l
630 if (perror(l).eq.132.)
631 & print *,'--- CRC errors! --- section ',l
632 if (perror(l).eq.133.)
633 & print *,'Problems with length of view: ',l,
634 & ' in raw mode length'
635 if (perror(l).eq.134.)
636 & print *,'Problems with length of view: ',l,
637 & ' in compress mode length'
638 if (perror(l).eq.135.)
639 & print *,'Problems with length of view: ',l,
640 & ' in full mode length'
641 if (perror(l).eq.136.)
642 & print *,'Acq mode problems with view: ',l
643 c if (perror(l).eq.137.)
644 c & print *,'Acq in compress mode, view: ',l
645 c if (perror(l).eq.138.)
646 c & print *,'Acq in full mode, view: ',l
647 if (perror(l).eq.139.)
648 & print *,'Problems with coding, view: ',l
649 if (perror(l).eq.140.)
650 & print *,'CHKSUM wrong, pedestal view: ',l
651 if (perror(l).eq.141.)
652 & print *,'CHKSUM wrong, thresholds view: ',l
653 if (perror(l).eq.142.)
654 & print *,'Packet length is zero! skipped: ',l
655 enddo
656 C
657 print *,' '
658 c if (iev.eq.0) then
659 c print *,' +++ RECORDED +++ iev = ',iev2
660 c else
661 print *,' +++ RECORDED +++ iev = ',iev
662 c endif
663 if (calevnum(1).eq.0..or.
664 & calevnum(2).eq.0..or.
665 & calevnum(3).eq.0..or.
666 & calevnum(4).eq.0.) then
667 print *,'-| ZERO COUNTER |- '
668 print *,' 1 ',calevnum(1)
669 print *,' 2 ',calevnum(2)
670 print *,' 3 ',calevnum(3)
671 print *,' 4 ',calevnum(4)
672 endif
673 print *,' '
674 print *,'*****************************************************'
675 c if (cho.eq.'debug') then
676 c call prevento
677 c goto 50
678 c endif
679
680
681
682 oldcalev0 = calev0
683 calev0 = calevnum(1)
684 oldcalev1 = calev1
685 calev1 = calevnum(2)
686 oldcalev2 = calevv2
687 calevv2 = calevnum(3)
688 oldcalev3 = calev3
689 calev3 = calevnum(4)
690 if ( (calev0+calev3-calevv2-calev1).ne.0 ) then
691 print *,'0 Event 0: ',calev0
692 print *,'1 Event 0: ',calev1
693 print *,'2 Event 0: ',calevv2
694 print *,'3 Event 0: ',calev3
695 endif
696 if ( (calev0 - oldcalev0 - 1).ne.0.or.
697 & (calev1 - oldcalev1 - 1).ne.0.or.
698 & (calevv2 - oldcalev2 - 1).ne.0.or.
699 & (calev3 - oldcalev3 - 1).ne.0 ) then
700 print *,'0 Event -1: ',oldcalev0
701 print *,'0 Event 0: ',calev0
702 print *,'1 Event -1: ',oldcalev1
703 print *,'1 Event 0: ',calev1
704 print *,'2 Event -1: ',oldcalev2
705 print *,'2 Event 0: ',calevv2
706 print *,'3 Event -1: ',oldcalev3
707 print *,'3 Event 0: ',calev3
708 endif
709
710
711 if (cho.eq.'pedestal') then
712 call hfnt(1)
713 elseif (cho.eq.'data') then
714 call hfnt(2)
715 elseif (cho.eq.'pulse') then
716 call hfnt(3)
717 elseif (cho.eq.'all') then
718 call hfnt(1)
719 call hfnt(2)
720 call hfnt(3)
721 endif
722 contr = 1
723 c
724 endif
725 C
726 666 continue
727 c
728 do p=1,40000
729 vecta(p) = 0
730 enddo
731 do l = 1,4
732 perror(l) = 0.
733 stwerr(l) = 0
734 stwer(l) = 0
735 perr(l) = 0
736 stwerr(l) = 0
737 perror(l) = 0.
738 enddo
739 call clearall
740 C
741 if (silofa.eq.2) goto 50
742 c
743 9 continue
744 c
745 enddo
746 10 FORMAT(2X,'Numero ',2X,I4,2X,' valore: ',Z8)
747 13 FORMAT(2X,'CRC dai dati ',Z8)
748 14 FORMAT(2X,'CRC calcolato ',Z128)
749 50 continue
750 C
751 CLOSE (44)
752 c
753 print *,'Any other data file (Y/N)?'
754 READ(*,51)answ
755 print *,answ
756 51 format(A1)
757 IF (ANSW.EQ.'Y'.or.answ.eq.'y') GOTO 7
758 c
759 c /* Save histograms */
760
761 c
762 CALL HROUT(0,icycle,' ')
763 CALL HREND('Event')
764 CLOSE (59)
765 C
766 C end
767 C
768 52 continue
769 RETURN
770 END
771
772

  ViewVC Help
Powered by ViewVC 1.1.23