/[PAMELA software]/tracker/ground/source/readraw/trkunpack.f
ViewVC logotype

Annotation of /tracker/ground/source/readraw/trkunpack.f

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.1 - (hide annotations) (download)
Wed Mar 8 15:00:40 2006 UTC (18 years, 10 months ago) by pam-fi
Branch point for: MAIN, trk-ground
Initial revision

1 pam-fi 1.1 *************************************************************************
2     * 10/9/2005 modified by david fedele to read buffer-data
3     * instead raw-data-file
4     * 29/11/2005 modified by david fedele to include crc control
5     *************************************************************************
6    
7     c*****************************************************
8     cccccc 10/9/2005 modified by david fedele
9     c subroutine trkeventpkt(YODAflag,event_file_name)
10     subroutine trkeventpkt(YODAflag,buffer,length_buffer,curpos,
11     $ startcrc,stopcrc,crctemp)
12     c*****************************************************
13    
14     include '../common/commontracker.f'
15     include '../common/common_readraw.f'
16     include '../common/level0.f'
17    
18    
19     * ---------------------------------------------------
20     * the general flag YODAflag contains information
21     * about the integrity of the packet.
22     *
23     * It is coded in bits:
24     * x xxxx xxxx xxxx xxxx
25     * | |||| |||| |||| ||||
26     * | |||| |||| |||| |||- integrity flag of 1 st DSP packet
27     * | |||| |||| |||| ||-- " " " 2 nd " "
28     * | |||| |||| |||| |--- " " " 3 rd " "
29     * | |||| ..............
30     * | |..................
31     * | ------------------- integrity flag of 12 th DSP packet
32     * |
33     * --------------------- flag that indicates if more than 12
34     * packets have been found
35     *
36     * EXAMPLE 1.
37     * If the event packet is truncated and only three DSP packets
38     * are present in the fragment, the last being TRUNCATED,
39     * the YODAflag will be:
40     *
41     * YODAflag = b#00000000000000100 = 4
42     *
43     * and only the two integer packets will be stored.
44     *
45     * EXAMPLE 2.
46     * If instead the corruption of a packet results from
47     * checksum or crc, the YODAflag will be asserted as explained,
48     * but the packet will be stored.
49     * ---------------------------------------------------
50     integer YODAflag
51    
52     logical DEBUG,ALARMs
53     common/DEBUGflag/DEBUG,ALARMS
54    
55    
56     integer runerror !readevent error flag
57    
58     c*****************************************************
59     cccccc 10/9/2005 modified by david fedele
60     c* integer ffd_pkt !pkt file descriptor
61     c* (file temporaneo)
62     c* character*60 event_file_name !nome file
63     c* integer lun_pkt
64     c* data lun_pkt/20/
65     parameter (MAXBUFFLEN=z'172c8')
66     integer*4 length_buffer
67     integer*1 buffer(MAXBUFFLEN)
68     integer curpos !current position in buffer
69     integer startcrc
70     integer stopcrc
71     integer*1 crctemp
72     c****************************************************
73    
74     integer last_trigger(nviews)
75     common/trigger_counter/last_trigger
76    
77    
78     YODAflag=0
79    
80     c*****************************************************
81     cccccc 10/9/2005 modified by david fedele
82     c open(unit=lun_pkt,
83     c $ name=EVENT_FILE_NAME(1:lnblnk(EVENT_FILE_NAME)),
84     c $ status='old',
85     c $ form='unformatted'
86     c $ )
87     c ffd_pkt = FNum(lun_pkt) !reads unix file descriptor
88     c*****************************************************
89    
90     call initlevel0
91    
92     TOTDATAlength = 0. !total length of data buffer
93     do iview=1,nviews!ndummy !loop on views
94     c*****************************************************
95     cccccc 10/9/2005 modified by david fedele
96     c call searchtrkheader(runerror,ffd_pkt)
97     call searchtrkheader(runerror,buffer,length_buffer,curpos,
98     $ startcrc)
99     c*****************************************************
100     if(runerror.eq.1.or.runerror.eq.-1) then
101     * --------------------------------------------------
102     * no further DSP packet has been found ==> go to end
103     * --------------------------------------------------
104     goto 2222 !go to end
105     endif
106    
107     if(checkheader.ne.2) then
108     print*,'>>>> ERROR <<<< (trkeventpkt)'
109     print*,'>>>> CPU packet type ',!pkt_type,
110     $ ' does not match DSP packet type ',checkheader
111     DAQmode_temp = ishft(iand(header(1),z'03f0'),-4)
112     DSPnumber_temp = iand(header(1),z'000f')
113     print*,' -----------------------------------'
114     $ ,iview
115     print*,' DSP number-----',int(DSPnumber_temp)
116     print*,' DAQ mode-------',int(DAQmode_temp)
117     print*,' -----------------------------------'
118     goto 2525 !next view (==> search another DSP header)
119     endif
120    
121     c*****************************************************
122     cccccc 10/9/2005 modified by david fedele
123     c call unpackdata(runerror,ffd_pkt)
124     call unpackdata(runerror,buffer,length_buffer,curpos,
125     $ startcrc,stopcrc,crctemp)
126     c write(*,100),crctemp,crc_dat
127     c 100 format('calc',z2,' dat',z2)
128     c******************************************************
129     if(runerror.eq.-1.or.runerror.eq.1)then
130     * -----------------------------------------------
131     * an error occurred while reading the packet data
132     * ===> assert packet error bit ===> go to end
133     * -----------------------------------------------
134     YODAflag=ior(YODAflag,int(2**(iview-1)))
135     goto 2222 !end
136     endif
137    
138     if(ALARMs)then
139     print*,' '
140     print*,' -----------------------------------',iview
141     print*,' DSP number-----',DSPnumber_dat
142     print*,' DAQ mode-------',DAQmode_dat
143     print*,' event number ',eventn_dat
144     print*,' datalength (13-bit w) ---- ',datalength_dat
145     print*,' L-1 addr---',addrcluster_dat(1)
146     print*,' signal-',signcluster_dat(1)
147     print*,' L-2 addr---',addrcluster_dat(2)
148     print*,' signal-',signcluster_dat(2)
149     print*,' L-3 addr---',addrcluster_dat(3)
150     print*,' signal-',signcluster_dat(3)
151     print*,' FC------',fc_dat
152     print*,' compression time ',compressiontime_dat
153     print*,' FL1--',fl1_dat
154     print*,' FL2--',fl2_dat
155     print*,' FL3--',fl3_dat
156     print*,' FL4--',fl4_dat
157     print*,' FL5--',fl5_dat
158     print*,' FL6--',fl6_dat
159    
160     print*,'*-*-*-*-*-*-TRAILER-*-*-*-*-*-*'
161     print*,'* PNUM (periferal num) ',pnum_dat
162     print*,'* CMDNUM (command) ',cmdnum_dat
163     print*,'* BID (board id) ',bid_dat
164     print*,'* ALARM ',alarm_dat
165     print*,'*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*'
166    
167     DEBUG = .true.
168     endif
169    
170     trk_DSP_ok(DSPnumber_dat)=1
171    
172     call fillview(iview,crctemp)
173    
174     2525 continue
175     enddo !end loop on views
176    
177     2222 continue
178    
179     c*****************************************************
180     cccccc 10/9/2005 modified by david fedele
181     c close (lun_pkt)
182     c*****************************************************
183     return
184     end
185    
186     * **********************************************
187    
188     c*****************************************************
189     cccccc 10/9/2005 modified by david fedele
190     c subroutine trkcalibpkt(runerror,event_file_name)
191     subroutine trkcalibpkt(runerror,buffer,length_buffer,curpos,
192     $ startcrc,stopcrc,crctemp)
193     c*****************************************************
194     include '../common/commontracker.f'
195     include '../common/common_readraw.f'
196    
197     integer runerror !readevent error flag
198     c******************************************************
199     cccccc 10/9/2005 modified by david fedele
200     c integer ffd_pkt !pkt file descriptor
201     c !(file temporaneo)
202     c character*60 event_file_name !nome file
203     c integer lun_pkt
204     c data lun_pkt/10/
205     parameter (MAXBUFFLEN=z'172c8')
206     integer*4 length_buffer
207     integer*1 buffer(MAXBUFFLEN)
208     integer curpos !current position in buffer
209     integer startcrc
210     integer stopcrc
211     integer*1 crctemp
212     c******************************************************
213     logical DEBUG,ALARMs
214     common/DEBUGflag/DEBUG,ALARMs
215     data DEBUG/.false./
216    
217    
218     integer ndummy
219     data ndummy/10/
220    
221    
222     c******************************************************
223     cccccc 10/9/2005 modified by david fedele
224     c open(unit=lun_pkt,
225     c $ name=EVENT_FILE_NAME(1:lnblnk(EVENT_FILE_NAME)),
226     c $ status='old',
227     c $ form='unformatted'
228     c $ )
229     c ffd_pkt = FNum(lun_pkt) !reads unix file descriptor
230     c******************************************************
231    
232     npa=0 !packet counter
233     do iview=1,ndummy !loop on views (DSP pkt)
234    
235     ALARMS=.false.
236    
237     c******************************************************
238     cccccc 10/9/2005 modified by david fedele
239     c call searchtrkheader(runerror,ffd_pkt)
240     call searchtrkheader(runerror,buffer,length_buffer,curpos,
241     $ startcrc)
242     c******************************************************
243    
244    
245     if(runerror.eq.-1) goto 2222
246     if(runerror.eq.1) then
247     goto 2222 !end loop on views (DSP pkt)
248     endif
249     if(checkheader.ne.3) then
250     print*,'>>>> ERROR <<<< (trkcalibpkt)'
251     print*,'>>>> CPU packet type ',!pkt_type,
252     $ ' does not match DSP type ',checkheader
253     DAQmode_temp = ishft(iand(header(1),z'03f0'),-4)
254     DSPnumber_temp = iand(header(1),z'000f')
255     print*,' -----------------------------------'
256     $ ,iview
257     print*,' DSP number-----',int(DSPnumber_temp)
258     print*,' DAQ mode-------',int(DAQmode_temp)
259     print*,' -----------------------------------'
260     goto 2424 !next view (==> search another DSP header)
261     endif
262    
263     c******************************************************
264     cccccc 10/9/2005 modified by david fedele
265     c call unpackcalibration(runerror,ffd_pkt)
266     call unpackcalibration(runerror,buffer,length_buffer,curpos,
267     $ startcrc,stopcrc,crctemp)
268     c******************************************************
269     if(runerror.eq.-1) goto 2222
270     if(runerror.eq.1) goto 2222
271    
272     if(nused_event.ne.0.or.ff.ne.0)then
273     print*,'*.*.*.*.*.*.*.*.*.*.*.*.*.*.*.*.*.*.*.*'
274     print*,'* !!! CALIBRATION FAILURE !!! *'
275     print*,'*.*.*.*.*.*.*.*.*.*.*.*.*.*.*.*.*.*.*.*'
276     c ALARMS=.true.
277     endif
278     if(ALARMS)then
279    
280     print*,'Calibration packet ==> ',iview
281    
282     print*,'---- Calibration packet ',iview,' ----'
283     print*,' DSP number ',DSPnumber_cal
284     print*,' DAQ mode ',DAQmode_cal
285     print*,' calibration run ',calibrationnumber
286     print*,' n. event used ',nused_event
287     print*,' <PED> ladder 1 ',ped_1
288     print*,' <PED> ladder 2 ',ped_2
289     print*,' <PED> ladder 3 ',ped_3
290     print*,' <SIG> ladder 1 ',sig_1
291     print*,' <SIG> ladder 2 ',sig_2
292     print*,' <SIG> ladder 3 ',sig_3
293     print*,' n.BAD ladder 1 ',nbad_1
294     print*,' n.BAD ladder 2 ',nbad_2
295     print*,' n.BAD ladder 3 ',nbad_3
296     print*,' error flag ',ff
297     endif
298     c
299     npa=npa+1
300     trk_DSP_ok(DSPnumber_cal)=1
301     2424 continue
302     enddo ! end loop on views (calibration pkt)
303     2222 continue
304    
305     if(npa.ne.6)print*,'**** READRAW: WARNING (in trkcalibpkt) '
306     $ //'- Found only ',npa,' calibration pkts!'
307     c*****************************************************
308     cccccc 10/9/2005 modified by david fedele
309     c close (lun_pkt)
310     c*****************************************************
311     return
312     end
313    
314     ***...***...***...***...***...***...***...***...***...***...***...***...***...***...***...***
315     *
316     *
317     *
318     *
319     *
320     *
321     *
322     *
323     ***...***...***...***...***...***...***...***...***...***...***...***...***...***...***...***
324    
325     c*****************************************************
326     cccccc 10/9/2005 modified by david fedele
327     c subroutine searchtrkheader(runerror,ffd)
328     subroutine searchtrkheader(runerror,buffer,length_buffer,
329     + curpos,startcrc)
330     c*****************************************************
331     C.............................................................
332     C Search for a valid tracker DSP header (=>one view)
333     C and return the type of header
334     C.............................................................
335    
336     include '../common/commontracker.f'
337     include '../common/common_readraw.f'
338    
339     c*****************************************************
340     cccccc 10/9/2005 modified by david fedele
341     c integer ffd !input file descriptor
342     parameter (MAXBUFFLEN=z'172c8')
343     integer*4 length_buffer
344     integer*1 buffer(MAXBUFFLEN)
345     integer curpos !current position in buffer
346     integer startcrc
347     c*****************************************************
348    
349     integer runerror !readevent error flag
350    
351     c--------------------------------------------------
352     c N.B.13 bit packing is done for each DSP header+datablock,
353     C so each DSP 13 bit
354     c first word starts at the beginnig of a 16 bit word
355     c--------------------------------------------------
356    
357     9100 continue
358     runerror=0 !error flag initialization
359     checkheader=0
360    
361     c--------------------------------------------------
362     c looks for a DSP header beginning
363     C (a word beginning with 1110)
364     c--------------------------------------------------
365    
366     c*****************************************************
367     cccccc 10/9/2005 modified by david fedele
368     c call findstart(runerror,ffd)
369     call findstart(runerror,buffer,length_buffer,curpos)
370     c*****************************************************
371    
372    
373     if(runerror.eq.1) goto 200 !end
374     if(runerror.eq.-1)goto 200 !end
375     c--------------------------------------------------
376     c the first word could be a DSP header first word:
377     C reads 13 8-bit words and
378     c writes them in 16 13-bit words to check for all
379     C DSP header features
380     c--------------------------------------------------
381    
382     c*****************************************************
383     cccccc 10/9/2005 modified by david fedele
384     c call hunpacker(header,runerror,ffd)
385     call hunpacker(header,runerror,buffer,length_buffer,curpos,
386     + startcrc)
387     c*****************************************************
388    
389     if(runerror.eq.1) goto 200 !end
390     if(runerror.eq.-1)goto 200 !end
391     c--------------------------------------------------
392     c extracts and controls header:
393     c--------------------------------------------------
394     C last header word must be:
395     c |0001|1100|0000|0000| for acquisition
396     c |0001|1111|1111|1111| for calibration
397     c--------------------------------------------------
398     if(iand(header(16),z'ffff').eq.z'1c00') then
399     checkheader=2 ! event packet
400     elseif(iand(header(16),z'ffff').eq.z'1fff') then
401     checkheader=3 ! calibration packet
402     else
403     checkheader=1 ! not a valid DSP header
404     endif
405     c--------------------------------------------------
406     c first header word must be:
407     c |0001|110x|xxxx|xxxx|
408     c--------------------------------------------------
409     if(iand(header(1),z'fe00').ne.z'1c00')
410     $ checkheader=1 !not a valid DSP header
411     c--------------------------------------------------
412     c intermediate header words must be:
413     c |0001|010x|xxxx|xxxx|
414     c--------------------------------------------------
415     do i=2,15
416     if(iand(header(i),z'fc00').ne.z'1400')
417     $ checkheader=1 !not a valid DSP header
418     enddo
419     c--------------------------------------------------
420     c if checkheader = 1
421     c then this is not a DSP header (or some
422     c noise lurks around) so go a word ahead and
423     c try again
424     c--------------------------------------------------
425     if(checkheader.eq.1) then
426    
427     c*****************************************************
428     cccccc 10/9/2005 modified by david fedele
429     c call skipbyte(ffd) !new search
430     curpos=curpos-(13*2)+1 !goes back 13 words, then half 16 bit word ahead
431     c*****************************************************
432     goto 9100
433     endif
434    
435     200 continue
436     end
437    
438     *.............................................................
439    
440    
441     *.............................................................
442     c*****************************************************
443     cccccc 10/9/2005 modified by david fedele
444     c subroutine unpackcalibration(runerror,ffd)
445     subroutine unpackcalibration(runerror,buffer,length_buffer,curpos,
446     $ startcrc,stopcrc,crctemp)
447     c*****************************************************
448    
449     *.............................................................
450     * decode calibration data
451     * header + data(PED SIG BAD) + trailer
452     *............................................................
453     include '../common/commontracker.f'
454     include '../common/common_readraw.f'
455    
456    
457     c*****************************************************
458     cccccc 10/9/2005 modified by david fedele
459     c integer ffd !input file descriptor
460     parameter (MAXBUFFLEN=z'172c8')
461     integer*4 length_buffer
462     integer*1 buffer(MAXBUFFLEN)
463     integer curpos !current position in buffer
464     integer startcrc
465     integer stopcrc
466     integer*1 crctemp
467     integer*1 crc_trail
468     c*****************************************************
469    
470     integer runerror !readevent error flag
471     c buffer temporanei
472     integer*2 templ(nstrips_ladder)
473     real*4 tempf(nstrips_ladder)
474    
475    
476     12 format(z4)
477    
478     *-----------------------------------------------------------
479     * HEADER
480     * (N.B. during test 2003 the header of calibration packets
481     * was only partially filled)
482     *
483     * the following is the final calibration header
484     *-----------------------------------------------------------
485     DAQmode_cal = ishft(iand(header(1),z'03f0'),-4)
486     DSPnumber_cal = iand(header(1),z'000f')
487     dataword = ior(ishft(iand(header(2),z'03ff')
488     $ ,10),iand(header(3),z'03ff'))
489     calibrationnumber = iand(header(4),z'03ff')
490     nused_event = iand(header(5),z'03ff')
491     ped_1 = iand(header(6),z'03ff')
492     ped_2 = iand(header(7),z'03ff')
493     ped_3 = iand(header(8),z'03ff')
494     ped_1 = ped_1 * 4
495     ped_2 = ped_2 * 4
496     ped_3 = ped_3 * 4
497     sig_1 = iand(header(9),z'03ff')
498     sig_2 = iand(header(10),z'03ff')
499     sig_3 = iand(header(11),z'03ff')
500     nbad_1 = iand(header(12),z'03ff')
501     nbad_2 = iand(header(13),z'03ff')
502     nbad_3 = iand(header(14),z'03ff')
503     ff = ishft(iand(header(15),z'0300'),-8)
504     checksum_cal = iand(header(15),z'00ff')
505     c-----------------------------------------------------------
506     c the checksum is a 8-bit word calculated as the
507     c XOR of the 16-bit data words,
508     c hence the XOR between the two halfs
509     C----------------------------------------------------------
510    
511     runerror=0
512    
513     c*****************************************************
514     cccccc 10/9/2005 modified by david fedele
515     c call readtrailer(trailer,runerror,ffd)
516     call readtrailer(trailer,runerror,buffer,length_buffer,curpos,
517     $ startcrc,stopcrc,crctemp)
518    
519     crc_trail=iand(trailer(3),z'00ff')
520    
521     if (crctemp.eq. crc_trail)then
522     crc_hcalib=.true.
523     else
524     crc_hcalib=.false.
525     print*,'**** READRAW: WARNING crc_hcalib=.false.'
526     write(*,102),il,crctemp,iand(trailer(3),z'00ff')
527     102 format(' crctemp=',z2
528     $ ,' crc-trailer=',z2)
529     endif
530     c*****************************************************
531    
532     do il=1,3 !loop on ladders
533     c*****************************************************
534     cccccc 30/11/2005 modified by david fedele
535     startcrc=curpos
536     c*****************************************************
537     cccccc 10/9/2005 modified by david fedele
538     c call readped(tempf,runerror,ffd)
539     call readped(tempf,runerror,buffer,length_buffer,curpos)
540     c*****************************************************
541     do is=1,nstrips_ladder
542     iss=is+nstrips_ladder*(il-1)
543     DSPped_o(DSPnumber_cal,iss)=tempf(is)
544     enddo
545    
546    
547     c*****************************************************
548     cccccc 10/9/2005 modified by david fedele
549     c call readsig(tempf,runerror,ffd)
550     call readsig(tempf,runerror,buffer,length_buffer,curpos)
551     c*****************************************************
552     do is=1,nstrips_ladder
553     iss=is+nstrips_ladder*(il-1)
554     DSPsig_o(DSPnumber_cal,iss)=tempf(is)
555     enddo
556    
557    
558     c*****************************************************
559     cccccc 10/9/2005 modified by david fedele
560     c call readbad(templ,runerror,ffd)
561     call readbad(templ,runerror,buffer,length_buffer,curpos)
562     c*****************************************************
563     do is=1,nstrips_ladder
564     iss=is+nstrips_ladder*(il-1)
565     DSPbad_o(DSPnumber_cal,iss)=templ(is)
566     enddo
567    
568     11 format(i1,' ',z4)
569    
570     c*****************************************************
571     cccccc 10/9/2005 modified by david fedele
572     c call readtrailer(trailer,runerror,ffd)
573     call readtrailer(trailer,runerror,buffer,length_buffer,curpos,
574     $ startcrc,stopcrc,crctemp)
575    
576     crc_trail=iand(trailer(3),z'00ff')
577    
578     if (crctemp.eq. crc_trail)then
579     crc_calib(il)=.true.
580     else
581     crc_calib(il)=.false.
582     print*,'**** READRAW: WARNING crc_cal(',il,')=.false. '
583     write(*,101),il,crctemp,iand(trailer(3),z'00ff')
584     101 format('ladder ',i2,' crctemp=',z2
585     $ ,' crc-trailer=',z2)
586     endif
587     c*****************************************************
588    
589     enddo !end loop on ladders
590    
591     return
592     end
593     *.............................................................
594    
595    
596     c*****************************************************
597     cccccc 10/9/2005 modified by david fedele
598     c subroutine unpackdata(runerror,ffd)
599     subroutine unpackdata(runerror,buffer,length_buffer,curpos,
600     $ startcrc,stopcrc,crctemp)
601     c*****************************************************
602    
603     *.............................................................
604     * decode event data
605     * header + data + trailer
606     *............................................................
607    
608     include '../common/commontracker.f'
609     include '../common/common_readraw.f'
610     include '../common/level0.f'
611    
612     c*****************************************************
613     cccccc 10/9/2005 modified by david fedele
614     c integer ffd !input file descriptor
615     parameter (MAXBUFFLEN=z'172c8')
616     integer*4 length_buffer
617     integer*1 buffer(MAXBUFFLEN)
618     integer curpos !current position in buffer
619     integer startcrc
620     integer stopcrc
621     integer*1 crctemp
622     c*****************************************************
623    
624     integer runerror !readevent error flag
625     integer l_tra
626    
627     integer bid1_dat,bid2_dat,bid3_dat,bid4_dat,bid5_dat,bid6_dat
628     $ ,bid7_dat,bid_dat_sum
629    
630     logical DEBUG,ALARMs
631     common/DEBUGflag/DEBUG,ALARMs
632     c data ALARMs/.false./
633    
634    
635     ALARMs = .false.
636    
637     12 format(z4)
638    
639     *-----------------------------------------------------------
640     * HEADER
641     *-----------------------------------------------------------
642    
643     DAQmode_dat = ishft(iand(header(1),z'03f0'),-4)
644     DSPnumber_dat = iand(header(1),z'000f')
645     C ------------------------------------------------------
646     c words 2 and 3 give the number of transmitted 16-bit
647     c words ( 13 header words + data )
648     c NB: data are packed from 13-bit to 16-bit words,
649     c so the stream is complited with zeros in order to have
650     c a number of bits multiple of 16
651     C ------------------------------------------------------
652     l_tra = ior(ishft(iand(header(2),z'03ff')
653     $ ,10),iand(header(3),z'03ff'))
654     l_tra=l_tra-13
655     C ------------------------------------------------------
656     eventn_dat = ior(ishft(iand(header(4),z'03ff')
657     $ ,10),iand(header(5),z'03ff'))
658     nclust_dat = ishft(iand(header(6),z'0380'),-7)
659     cutc_dat = ishft(iand(header(6),z'0070'),-4)
660     cutcl_dat = iand(header(6),z'000f')
661     addrcluster_dat(1) = iand(header(7),z'03ff')
662     signcluster_dat(1) = iand(header(8),z'03ff')
663     addrcluster_dat(2) = iand(header(9),z'03ff')
664     signcluster_dat(2) = iand(header(10),z'03ff')
665     addrcluster_dat(3) = iand(header(11),z'03ff')
666     signcluster_dat(3) = iand(header(12),z'03ff')
667     fc_dat = ishft(iand(header(13),z'0300'),-8)
668     compressiontime_dat = iand(header(13),z'00ff')
669     fl5_dat = ishft(iand(header(14),z'0300'),-8)
670     fl4_dat = ishft(iand(header(14),z'0300'),-6)
671     fl3_dat = ishft(iand(header(14),z'0300'),-4)
672     fl2_dat = ishft(iand(header(14),z'0300'),-2)
673     fl1_dat = iand(header(14),z'0300')
674     fl6_dat = ishft(iand(header(15),z'0300'),-8)
675     checksum_dat = iand(header(15),z'00ff')
676    
677     if(
678     $ fc_dat.ne.0.or.
679     $ fl1_dat.ne.0.or.
680     $ fl2_dat.ne.0.or.
681     $ fl3_dat.ne.0.or.
682     $ fl4_dat.ne.0.or.
683     $ fl5_dat.ne.0.or.
684     $ fl6_dat.ne.0.or.
685     $ .false.)ALARMs=.true.
686     c-----------------------------------------------------------
687     c the cheacksum is a 8-bit word calculated as the
688     c XOR of the 16-bit data words,
689     c hence the XOR between the two halfs
690     C----------------------------------------------------------
691     runerror=0
692     nqualcosa=0
693     if(l_tra.eq.0)then
694     ALARMs=.true.
695     goto 18 !empty buffer
696     endif
697    
698     c*****************************************************
699     cccccc 10/9/2005 modified by david fedele
700     c call dunpacker(l_tra,b_tra,runerror,ffd)
701     call dunpacker(l_tra,b_tra,runerror,buffer,length_buffer,curpos)
702     c*****************************************************
703     if(runerror.eq.1.or.runerror.eq.-1) then
704     goto 50 !go to end
705     endif
706    
707     nqualcosa = (real(l_tra))/13*16
708     xx = b_tra(nqualcosa)
709     if (xx.eq.0) nqualcosa=nqualcosa -1
710    
711     18 datalength_dat= nqualcosa
712     11 format(i1,' ',z4)
713    
714     c*****************************************************
715     cccccc 10/9/2005 modified by david fedele
716     c call readtrailer(trailer,runerror,ffd)
717     call readtrailer(trailer,runerror,buffer,length_buffer,curpos,
718     $ startcrc,stopcrc,crctemp)
719     c*****************************************************
720    
721     ***************************************************************
722     * TRAILER *
723     ***************************************************************
724    
725     pnum_dat=ishft(iand(trailer(1),z'f000'),-12)
726     cmdnum_dat=ishft(iand(trailer(1),z'0f00'),-8)
727     bid1_dat=ishft(iand(trailer(1),z'00c0'),-6)
728     bid2_dat=ishft(iand(trailer(1),z'0030'),-4)
729     bid3_dat=ishft(iand(trailer(1),z'000c'),-2)
730     bid4_dat=iand(trailer(1),z'0003')
731     bid5_dat=ishft(iand(trailer(2),z'c000'),-14)
732     bid6_dat=ishft(iand(trailer(2),z'3000'),-12)
733     bid7_dat=ishft(iand(trailer(2),z'0c00'),-10)
734     alarm_dat=ishft(iand(trailer(2),z'0300'),-8)
735     aswr_dat=ior(ishft(iand(trailer(2),z'00ff'),8)
736     $ ,ishft(iand(trailer(3),z'ff00'),-8))
737     crc_dat=iand(trailer(3),z'00ff')
738    
739     bid_dat_sum = (bid1_dat + bid2_dat + bid3_dat + bid4_dat +
740     & bid5_dat + bid6_dat + bid7_dat)
741    
742     bid_dat = bid_dat_sum/7
743    
744     if ((bid_dat.ne.1.and.bid_dat.ne.2).or.
745     $ (mod(bid_dat_sum,7).ne.0).or.
746     $ .false.) then
747     write(*,*) '*** *** *** *** *** *** *** *** *** *** *** ***'
748     write(*,*) 'unpack_data: TRAILER PACKET CORRUPTED - <BID> '
749     $ ,bid_dat
750     write(*,*) '*** *** *** *** *** *** *** *** *** *** *** ***'
751     ALARMs=.true.
752     endif
753    
754    
755     if (alarm_dat.eq.3) then
756     write(*,*) '--- --- --- --- --- --- --- --- --- --- ---'
757     write(*,*) 'unpack_data: TRAILER --- AQUISITION ALARM!!!'
758     write(*,*) '--- --- --- --- --- --- --- --- --- --- ---'
759     write(*,*) alarm_dat
760     ALARMs=.true.
761    
762     endif
763    
764     if (alarm_dat.ne.3.and.alarm_dat.ne.0) then
765     write(*,*) '*** *** *** *** *** *** *** *** *** *** *** *** **'
766     write(*,*) 'unpack_data: TRAILER PACKET CORRUPTED - ALARM '
767     $ ,alarm_dat
768     write(*,*) '*** *** *** *** *** *** *** *** *** *** *** *** **'
769     ALARMs=.true.
770     endif
771    
772    
773     50 return
774     end
775    
776    
777     *.............................................................................
778     subroutine initlevel0
779    
780     include '../common/commontracker.f'
781     include '../common/level0.f'
782    
783     do i=1, nviews
784    
785     DAQmode(i) = 0
786     DSPnumber(i) = 0
787     eventn(i) = 0
788     nclust(i) = 0
789     cutc(i) = 0
790     cutcl(i) = 0
791     addrcluster(i,1) = 0
792     signcluster(i,1) = 0
793     addrcluster(i,2) = 0
794     signcluster(i,2) = 0
795     addrcluster(i,3) = 0
796     signcluster(i,3) = 0
797     fc(i) = 0
798     compressiontime(i) = 0
799     fl5(i) = 0
800     fl4(i) = 0
801     fl3(i) = 0
802     fl2(i) = 0
803     fl1(i) = 0
804     fl6(i) = 0
805     checksum(i) = 0
806     DATAlength(i) = 0
807     pnum(i)= 0
808     cmdnum(i)= 0
809     bid(i) = 1
810     alarm(i)= 0
811     aswr(i) = 0
812     c*****************************************************
813     cccccc 10/9/2005 modified by david fedele
814     crc(i)=.true.
815     c*****************************************************
816     enddo
817    
818     TOTDATAlength = 0
819     good0=.true.
820    
821     return
822     end
823    
824    
825     * *** *** *** *** *** *** *** *** ***
826     *
827     *
828     *
829     *
830     *
831     *
832     * *** *** *** *** *** *** *** *** ***
833     subroutine fillview(i,crctemp)
834     c -----------------------------------------------------
835     c fill variables related to view i
836     c which will be stored in the level0 nt-ple
837     c at the end of loop on views
838     c ----------------------------------------------------
839    
840     include '../common/commontracker.f'
841     include '../common/level0.f'
842     include '../common/common_readraw.f'
843    
844     integer*1 crctemp
845    
846     DAQmode(i) = DAQmode_dat
847     DSPnumber(i) = DSPnumber_dat
848     eventn(i) = eventn_dat
849     nclust(i) = nclust_dat
850     cutc(i) = cutc_dat
851     cutcl(i) = cutcl_dat
852     addrcluster(i,1) = addrcluster_dat(1)
853     signcluster(i,1) = signcluster_dat(1)
854     addrcluster(i,2) = addrcluster_dat(2)
855     signcluster(i,2) = signcluster_dat(2)
856     addrcluster(i,3) = addrcluster_dat(3)
857     signcluster(i,3) = signcluster_dat(3)
858     fc(i) = fc_dat
859     compressiontime(i) = compressiontime_dat
860     fl5(i) = fl5_dat
861     fl4(i) = fl4_dat
862     fl3(i) = fl3_dat
863     fl2(i) = fl2_dat
864     fl1(i) = fl1_dat
865     fl6(i) = fl6_dat
866     checksum(i) = checksum_dat
867     DATAlength(i) = datalength_dat
868     c*****************************************************
869     cccccc 1/12/2005 modified by david fedele
870     if(crctemp.eq.crc_dat)then
871     crc(i)=.true.
872     else
873     print*,'**** READRAW: WARNING crc(',i,')=.false. '
874     write(*,100),crctemp,crc_dat
875     100 format('crctemp=',z2,' crc_dat=',z6)
876     crc(i)=.false.
877     endif
878     c*****************************************************
879    
880     c -----------------------------------------------------------------------
881     c filling TRAILER variables
882     c ----------------------------------------------------------------------
883    
884     pnum(i)= pnum_dat
885     cmdnum(i)= cmdnum_dat
886     bid(i) = bid_dat
887     alarm(i)= alarm_dat
888     aswr(i) = aswr_dat
889    
890     do idat=1,datalength_dat
891     id = TOTDATAlength + idat
892     datatracker(id) = b_tra(idat)
893     enddo
894     TOTDATAlength = TOTDATAlength + datalength_dat
895    
896     return
897     end
898    

  ViewVC Help
Powered by ViewVC 1.1.23