***...***...***...***...***...***...***...***...***...***...***...***...***...***...***...*** * * * * * * * * 10/9/2005 modified by david fedele to include general variables * ***...***...***...***...***...***...***...***...***...***...***...***...***...***...***...*** *............................................................................. subroutine book_level0 include '../common/commontracker.f' include '../common/level0.f' c print*,'__________ booking LEVEL0 n-tuple __________' c LEVEL0 ntuple: call HBNT(ntp_level0,'LEVEL0',' ') c***************************************************** cccccc 10/9/2005 modified by david fedele c call HBNAME(ntp_level0,'EVENT',good0 call HBNAME(ntp_level0,'GENERAL',good0 $ ,'GOOD0:L $ ,NEV0:I'// c***************************************************** cccccc 10/9/2005 modified by david fedele + ' ,WHICH_CALIB:I $ ,SWCODE:I') c***************************************************** call HBNAME(ntp_level0,'CPU',pkt_type $ ,'PKT_TYPE:I $ ,PKT_NUM:I $ ,OBT:I'// c***************************************************** cccccc 10/9/2005 modified by david fedele c $ ,WICH_CALIB:I') + ',CPU_CRC:L') c***************************************************** call HBNAME(ntp_level0,'HEADER',DAQmode !??? aggiustare il 12 con i block... $ ,'DAQMODE(12):I::[0,31] $ ,DSPNUMBER(12):I::[0,12] $ ,DATALENGTH(12):I::[0,4095] $ ,EVENTN(12):I $ ,NCLUST(12):I::[0,7] $ ,CUTC(12):I::[0,7] $ ,CUTCL(12):I::[0,15] $ ,ADDRCLUSTER(12,3):I::[0,1023] $ ,SIGNCLUSTER(12,3):I::[0,4095] $ ,FC(12):I::[0,3] $ ,COMPRESSIONTIME(12):I::[0,255] $ ,FL5(12):I::[0,3] $ ,FL4(12):I::[0,3] $ ,FL3(12):I::[0,3] $ ,FL2(12):I::[0,3] $ ,FL1(12):I::[0,3] $ ,FL6(12):I::[0,3] $ ,CHECKSUM(12):I::[0,255]'// c***************************************************** cccccc 10/9/2005 modified by david fedele + ',CRC(12):L') c***************************************************** call HBNAME(ntp_level0,'DATA',TOTDATAlength $ ,'TOTDATALENGTH:I::[0,49152] $ ,DATATRACKER(TOTDATALENGTH):I::[0,6150]') c $ ,DATATRACKER(TOTDATALENGTH):I') call HBNAME(ntp_level0,'TRAILER',PNUM $ ,'PNUM(12):I::[0,5] $ ,CMDNUM(12):I::[0,9] $ ,BID(12):I::[1,2] $ ,ALARM(12):I::[0,3] $ ,ASWR(12):I::[0,65535]') c------------------------------------------------------ c create the routine to access the n-tuple c------------------------------------------------------ c OPEN(10,FILE='../common/access_level0.f.temp',STATUS='UNKNOWN') c call HUWFUN(10,ntp_level0,'access_level0',0,'B') c CLOSE(10) return end *............................................................................. c***************************************************** cccccc 10/9/2005 modified by david fedele c$$$ subroutine init_level0 c$$$ c$$$ include '../common/level0.f' c$$$ c$$$ c$$$ do i=1, nviews c$$$ c$$$ DAQmode(i) = 0 c$$$ DSPnumber(i) = 0 c$$$ eventn(i) = 0 c$$$ nclust(i) = 0 c$$$ cutc(i) = 0 c$$$ cutcl(i) = 0 c$$$ addrcluster(i,1) = 0 c$$$ signcluster(i,1) = 0 c$$$ addrcluster(i,2) = 0 c$$$ signcluster(i,2) = 0 c$$$ addrcluster(i,3) = 0 c$$$ signcluster(i,3) = 0 c$$$ fc(i) = 0 c$$$ compressiontime(i) = 0 c$$$ fl5(i) = 0 c$$$ fl4(i) = 0 c$$$ fl3(i) = 0 c$$$ fl2(i) = 0 c$$$ fl1(i) = 0 c$$$ fl6(i) = 0 c$$$ checksum(i) = 0 c$$$ DATAlength(i) = 0 c$$$ pnum(i)= 0 c$$$ cmdnum(i)= 0 c$$$ bid(i) = 1 c$$$ alarm(i)= 0 c$$$ aswr(i) = 0 c$$$ enddo c$$$ c$$$ TOTDATAlength = 0 c$$$c good0=.true. c$$$ c$$$ return c$$$ end c$$$ c$$$*............................................................................. c$$$ c$$$ subroutine fill_view(i) c$$$c ----------------------------------------------------- c$$$c fill variables related to view i c$$$c which will be stored in the level0 nt-ple c$$$c at the end of loop on views c$$$c ---------------------------------------------------- c$$$ c$$$ include '../common/commontracker.f' c$$$ include '../common/level0.f' c$$$ include '../common/common_readraw.f' c$$$ c$$$ DAQmode(i) = DAQmode_dat c$$$ DSPnumber(i) = DSPnumber_dat c$$$ eventn(i) = eventn_dat c$$$ nclust(i) = nclust_dat c$$$ cutc(i) = cutc_dat c$$$ cutcl(i) = cutcl_dat c$$$ addrcluster(i,1) = addrcluster_dat(1) c$$$ signcluster(i,1) = signcluster_dat(1) c$$$ addrcluster(i,2) = addrcluster_dat(2) c$$$ signcluster(i,2) = signcluster_dat(2) c$$$ addrcluster(i,3) = addrcluster_dat(3) c$$$ signcluster(i,3) = signcluster_dat(3) c$$$ fc(i) = fc_dat c$$$ compressiontime(i) = compressiontime_dat c$$$ fl5(i) = fl5_dat c$$$ fl4(i) = fl4_dat c$$$ fl3(i) = fl3_dat c$$$ fl2(i) = fl2_dat c$$$ fl1(i) = fl1_dat c$$$ fl6(i) = fl6_dat c$$$ checksum(i) = checksum_dat c$$$ DATAlength(i) = datalength_dat c$$$ c$$$c ----------------------------------------------------------------------- c$$$c filling TRAILER variables c$$$c ---------------------------------------------------------------------- c$$$ c$$$ pnum(i)= pnum_dat c$$$ cmdnum(i)= cmdnum_dat c$$$ bid(i) = bid_dat c$$$ alarm(i)= alarm_dat c$$$ aswr(i) = aswr_dat c$$$ c$$$ c$$$ do idat=1,datalength_dat c$$$ id = TOTDATAlength + idat c$$$ datatracker(id) = b_tra(idat) c$$$ enddo c$$$ TOTDATAlength = TOTDATAlength + datalength_dat c$$$ c$$$ return c$$$ end c$$$ c*********************************************************** *............................................................................. subroutine book_histos include '../common/commontracker.f' include '../common/calib.f' character*64 title !histos title c badstrip, pedestal and sigma histograms booking for each view: c print*,' ' c print*,'-------- booking histos -------' c print*,' ' do i=1,nviews 402 format('Online BAD strips, view: ',i2) write(title,402) i c print*,title call HBOOK1(id_hi_bad+i,title,nstrips_view $ ,0.5,nstrips_view+0.5,0.) 403 format('Online PEDESTAL values, view: ',i2) write(title,403) i c print*,title call HBOOK1(id_hi_ped+i,title,nstrips_view $ ,0.5,nstrips_view+0.5,0.) 404 format('Online SIGMA values, view: ',i2) write(title,404) i c print*,title call HBOOK1(id_hi_sig+i,title,nstrips_view $ ,0.5,nstrips_view+0.5,0.) enddo return end *............................................................................. subroutine fill_histos include '../common/commontracker.f' include '../common/calib.f' include '../common/common_readraw.f' do iview=1,nviews do j=1,nstrips_view call HFILL(id_hi_bad+iview,float(j),0. $ ,float(DSPbad_o(iview,j))) call HFILL(id_hi_ped+iview,float(j),0.,DSPped_o(iview,j)) call HFILL(id_hi_sig+iview,float(j),0.,DSPsig_o(iview,j)) enddo c print*,'****',DSPsig_o(iview,2000) enddo return end *............................................................................. subroutine book_tof c include '../common/commontracker.f' include '../tof/common_tof.f' c print*,'__________ booking TOF n-tuple __________' c LEVEL0 ntuple: call HBNT(ntp_tof,'TOF',' ') call HBNAME(ntp_tof,'EVENT',good,'GOOD:L,NEV_TRK:I') call HBNAME(ntp_tof,'TRIGGER',trig_evcount $ ,'TRIG_EVCOUNT:I $ ,PMTPL(3):I $ ,TRIGRATE(6):I $ ,DLTIME(2):I $ ,S4CALCOUNT(2):I $ ,PMTCOUNT1(24):I $ ,PMTCOUNT2(24):I $ ,PATTERNBUSY(3):I $ ,PATTERNTRIG(6):I $ ,TRIGCONF:I') call HBNAME(ntp_tof,'TOF',tdcid $ ,'TDCID(12):I $ ,EVCOUNT(12):I $ ,TDCMASK(12):I $ ,ADC(4,12):I $ ,TDC(4,12):I $ ,TEMP1(12):I $ ,TEMP2(12):I') return end *............................................................................. subroutine init_tof include '../tof/common_tof.f' do i=1,12 tdcid(i)=0 evcount(i)=0 tdcmask(i)=0 temp1(i)=0 temp2(i)=0 do j=1,4 adc(j,i)=0 tdc(j,i)=0 enddo enddo return end *............................................................................. c--------------------------------------------------------------------------- c add a entry in the calibration list file DW_DATE_NUM_calib.txt, which c contains the list of the calibration file name to be associated to c each event c--------------------------------------------------------------------------- subroutine add_calib_entry include '../common/commontracker.f' include '../common/common_readraw.f' 111 format(i5,' ',a25) n_cal_list=n_cal_list+1 !calibration file identifier in the calibration list file write(lun_calib_list,111) n_cal_list $ ,file_calib return end ***...***...***...***...***...***...***...***...***...***...***...***...***...***...***...*** * * * * * * * * ***...***...***...***...***...***...***...***...***...***...***...***...***...***...***...*** c***************************************************** c$$$cccccc 10/9/2005 modified by david fedele c$$$ subroutine search_trk_header(runerror,ffd) c$$$C............................................................. c$$$C Search for a valid tracker DSP header (=>one view) c$$$C and return the type of header c$$$C............................................................. c$$$ c$$$ include '../common/commontracker.f' c$$$ include '../common/common_readraw.f' c$$$ c$$$ integer ffd !input file descriptor c$$$ integer runerror !readevent error flag c$$$ c$$$c-------------------------------------------------- c$$$c N.B.13 bit packing is done for each DSP header+datablock, c$$$C so each DSP 13 bit c$$$c first word starts at the beginnig of a 16 bit word c$$$c-------------------------------------------------- c$$$ 9100 continue c$$$ runerror=0 !error flag initialization c$$$ checkheader=0 c$$$ c$$$c-------------------------------------------------- c$$$c looks for a DSP header beginning c$$$C (a word beginning with 1110) c$$$c-------------------------------------------------- c$$$ call findstart(runerror,ffd) c$$$ c$$$ if(runerror.eq.1) goto 200 c$$$ if(runerror.eq.-1)then c$$$ runerror=1 !in this case I dont want the c$$$ !the program to crash c$$$ goto 200 c$$$ endif c$$$c-------------------------------------------------- c$$$c the first word could be a DSP header first word: c$$$C reads 13 8-bit words and c$$$c writes them in 16 13-bit words to check for all c$$$C DSP header features c$$$c-------------------------------------------------- c$$$ runerror=0 c$$$ c$$$ call hunpacker(header,runerror,ffd) c$$$ c$$$ if(runerror.eq.1) goto 200 c$$$c if(runerror.eq.-1) goto 200 c$$$ if(runerror.eq.-1)then c$$$ runerror=1 !in this case I dont want the c$$$ !the program to crash c$$$ goto 200 c$$$ endif c$$$c-------------------------------------------------- c$$$c extracts and controls header: c$$$c-------------------------------------------------- c$$$C last header word must be: c$$$c |0001|1100|0000|0000| for acquisition c$$$c |0001|1111|1111|1111| for calibration c$$$c-------------------------------------------------- c$$$ if(iand(header(16),z'ffff').eq.z'1c00') then !last header c$$$ checkheader=2 ! event c$$$ elseif(iand(header(16),z'ffff').eq.z'1fff') then !last header c$$$ checkheader=3 ! calibration packet c$$$ else c$$$ checkheader=1 ! not a valid DSP header c$$$ endif c$$$c-------------------------------------------------- c$$$c first header word must be: c$$$c |0001|110x|xxxx|xxxx| c$$$c-------------------------------------------------- c$$$ if(iand(header(1),z'fe00').ne.z'1c00') c$$$ $ checkheader=1 !not a valid DSP header c$$$c-------------------------------------------------- c$$$c intermediate header words must be: c$$$c |0001|010x|xxxx|xxxx| c$$$c-------------------------------------------------- c$$$ do i=2,15 c$$$ if(iand(header(i),z'fc00').ne.z'1400') c$$$ $ checkheader=1 !not a valid DSP header c$$$ enddo c$$$c-------------------------------------------------- c$$$c if checkheader = 1 c$$$c then this is not a DSP header (or some c$$$c noise lurks around) so go a word ahead and c$$$c try again c$$$c-------------------------------------------------- c$$$ if(checkheader.eq.1) then c$$$ call skipbyte(ffd) c$$$ goto 9100 c$$$ endif c$$$ 200 continue c$$$ end c$$$ c$$$*............................................................. c$$$ c$$$ subroutine unpack_calibration(runerror,ffd) c$$$*............................................................. c$$$* decode calibration data c$$$* header + data(PED SIG BAD) + trailer c$$$*............................................................ c$$$ include '../common/commontracker.f' c$$$ include '../common/common_readraw.f' c$$$ include '../common/calib.f' c$$$ c$$$ integer ffd !input file descriptor c$$$ integer runerror !readevent error flag c$$$c buffer temporanei c$$$ integer*2 templ(nstrips_ladder) c$$$ real*4 tempf(nstrips_ladder) c$$$ c$$$ c$$$ 12 format(z4) c$$$ c$$$*----------------------------------------------------------- c$$$* HEADER c$$$* (N.B. during test 2003 the header of calibration packets c$$$* was only partially filled) c$$$*----------------------------------------------------------- c$$$ DAQmode_cal = ishft(iand(header(1),z'03f0'),-4) c$$$ DSPnumber_cal = iand(header(1),z'000f') c$$$ dataword = ior(ishft(iand(header(2),z'03ff') c$$$ $ ,10),iand(header(3),z'03ff')) c$$$ calibrationnumber = ior(ishft(iand(header(4) c$$$ $ ,z'03ff'),10),iand(header(5),z'03ff')) c$$$ ff = ishft(iand(header(15),z'0300'),-8) c$$$ checksum_cal = iand(header(15),z'00ff') c$$$ c$$$ runerror=0 c$$$ call readtrailer(trailer,runerror,ffd) c$$$c----------------------------------------------------------- c$$$c the cheacksum is a 8-bit word calculated as the c$$$c XOR of the 16-bit data words, c$$$c hence the XOR between the two halfs c$$$C---------------------------------------------------------- c$$$ do il=1,3 !loop on ladders c$$$ c$$$ call readped(tempf,runerror,ffd) c$$$ do is=1,nstrips_ladder c$$$ iss=is+nstrips_ladder*(il-1) c$$$ DSPped_o(DSPnumber_cal,iss)=tempf(is) c$$$c print*,il,iss,DSPped_o(DSPnumber,iss) c$$$ enddo c$$$ c$$$ call readsig(tempf,runerror,ffd) c$$$ do is=1,nstrips_ladder c$$$ iss=is+nstrips_ladder*(il-1) c$$$ DSPsig_o(DSPnumber_cal,iss)=tempf(is) c$$$c print*,DSPsig_o(DSPnumber,iss) c$$$ enddo c$$$ c$$$ call readbad(templ,runerror,ffd) c$$$ do is=1,nstrips_ladder c$$$ iss=is+nstrips_ladder*(il-1) c$$$ DSPbad_o(DSPnumber_cal,iss)=templ(is) c$$$c print*,il,is,iss,DSPbad_o(DSPnumber,iss) c$$$ enddo c$$$ c$$$C//// CAPIRE PERCHE` NON C'E` LA PAROLA DI FINE LADDER \\\\ c$$$c call readeol(word,runerror,ffd) c$$$ 11 format(i1,' ',z4) c$$$ call readtrailer(trailer,runerror,ffd) c$$$ c$$$c print*,'fine ladder' !??? c$$$ c$$$ enddo !end loop on ladders c$$$ c$$$ return c$$$ end c$$$*............................................................. c$$$ c$$$ subroutine unpack_data(runerror,ffd) c$$$*............................................................. c$$$* decode event data c$$$* header + data + trailer c$$$*............................................................ c$$$ include '../common/commontracker.f' c$$$ include '../common/common_readraw.f' c$$$ include '../common/level0.f' c$$$ c$$$ integer ffd !input file descriptor c$$$ integer runerror !readevent error flag c$$$ integer l_tra c$$$ c$$$ c$$$ 12 format(z4) c$$$ c$$$*----------------------------------------------------------- c$$$* HEADER c$$$*----------------------------------------------------------- c$$$ c$$$ DAQmode_dat = ishft(iand(header(1),z'03f0'),-4) c$$$ DSPnumber_dat = iand(header(1),z'000f') c$$$C ------------------------------------------------------ c$$$c words 2 and 3 give tshe number of transmitted 16-bit c$$$c words ( 13 header words + data ) c$$$c NB: data are packed from 13-bit to 16-bit words, c$$$c so the stream is complited with zeros in order to have c$$$c a number of bits multiple of 16 c$$$ l_tra = ior(ishft(iand(header(2),z'03ff') c$$$ $ ,10),iand(header(3),z'03ff')) c$$$ l_tra=l_tra-13 c$$$C ------------------------------------------------------ c$$$ eventn_dat = ior(ishft(iand(header(4),z'03ff') c$$$ $ ,10),iand(header(5),z'03ff')) c$$$ nclust_dat = ishft(iand(header(6),z'0380'),-7) c$$$ cutc_dat = ishft(iand(header(6),z'0070'),-4) c$$$ cutcl_dat = iand(header(6),z'000f') c$$$ addrcluster_dat(1) = iand(header(7),z'03ff') c$$$ signcluster_dat(1) = iand(header(8),z'03ff') c$$$ addrcluster_dat(2) = iand(header(9),z'03ff') c$$$ signcluster_dat(2) = iand(header(10),z'03ff') c$$$ addrcluster_dat(3) = iand(header(11),z'03ff') c$$$ signcluster_dat(3) = iand(header(12),z'03ff') c$$$ fc_dat = ishft(iand(header(13),z'0300'),-8) c$$$ compressiontime_dat = iand(header(13),z'00ff') c$$$ fl5_dat = ishft(iand(header(14),z'0300'),-8) c$$$ fl4_dat = ishft(iand(header(14),z'0300'),-6) c$$$ fl3_dat = ishft(iand(header(14),z'0300'),-4) c$$$ fl2_dat = ishft(iand(header(14),z'0300'),-2) c$$$ fl1_dat = iand(header(14),z'0300') c$$$ fl6_dat = ishft(iand(header(15),z'0300'),-8) c$$$ checksum_dat = iand(header(15),z'00ff') c$$$c----------------------------------------------------------- c$$$c the cheacksum is a 8-bit word calculated as the c$$$c XOR of the 16-bit data words, c$$$c hence the XOR between the two halfs c$$$C---------------------------------------------------------- c$$$ runerror=0 c$$$ call dunpacker(l_tra,b_tra,runerror,ffd) c$$$ nqualcosa = (real(l_tra))/13*16 c$$$ xx = b_tra(nqualcosa) c$$$ if (xx.eq.0) nqualcosa=nqualcosa -1 c$$$ datalength_dat= nqualcosa c$$$ c$$$ c$$$ c$$$ 11 format(i1,' ',z4) c$$$ call readtrailer(trailer,runerror,ffd) c$$$ c$$$*************************************************************** c$$$* TRAILER * c$$$*************************************************************** c$$$ c$$$ pnum_dat=ishft(iand(trailer(1),z'f000'),-12) c$$$ cmdnum_dat=ishft(iand(trailer(1),z'0f00'),-8) c$$$ bid1_dat=ishft(iand(trailer(1),z'00c0'),-6) c$$$ bid2_dat=ishft(iand(trailer(1),z'0030'),-4) c$$$ bid3_dat=ishft(iand(trailer(1),z'000c'),-2) c$$$ bid4_dat=iand(trailer(1),z'0003') c$$$ bid5_dat=ishft(iand(trailer(2),z'c000'),-14) c$$$ bid6_dat=ishft(iand(trailer(2),z'3000'),-12) c$$$ bid7_dat=ishft(iand(trailer(2),z'0c00'),-10) c$$$ alarm_dat=ishft(iand(trailer(2),z'0300'),-8) c$$$ aswr_dat=ior(ishft(iand(trailer(2),z'00ff'),8) c$$$ $ ,ishft(iand(trailer(3),z'ff00'),-8)) c$$$ crc_dat=iand(trailer(3),z'00ff') c$$$ c$$$ bid_dat_sum = (bid1_dat + bid2_dat + bid3_dat + bid4_dat + c$$$ & bid5_dat + bid6_dat + bid7_dat) c$$$ c$$$ bid_dat = bid_dat_sum/7 c$$$ c$$$ if (bid_dat.ne.1.and.bid_dat.ne.2) then c$$$ write(*,*) '*** *** *** *** *** *** *** *** *** ***' c$$$ write (*,*) 'unpack_data: TRAILER PACKET CORRUPTED' c$$$ write(*,*) '*** *** *** *** *** *** *** *** *** ***' c$$$ endif c$$$ if (mod(bid_dat_sum,7).ne.0) then c$$$ bid_dat = 0 c$$$ write(*,*) '*** *** *** *** *** *** *** *** *** ***' c$$$ write (*,*) 'unpack_data: TRAILER PACKET CORRUPTED' c$$$ write(*,*) '*** *** *** *** *** *** *** *** *** ***' c$$$ endif c$$$ c$$$ if (alarm_dat.eq.3) then c$$$ write(*,*) '*** *** *** *** *** *** *** *** *** ***' c$$$ write(*,*) 'unpack_data: AQUISITION ALARM' c$$$ write(*,*) '*** *** *** *** *** *** *** *** *** ***' c$$$ c$$$ endif c$$$ c$$$ if (alarm_dat.ne.3.and.alarm_dat.ne.0) then c$$$ write(*,*) '*** *** *** *** *** *** *** *** *** ***' c$$$ write(*,*) 'unpack_data: TRAILER PACKET CORRUPTED' c$$$ write(*,*) '*** *** *** *** *** *** *** *** *** ***' c$$$ c$$$ endif c$$$ c$$$ c$$$ return c$$$ end c***************************************************************** ***...***...***...***...***...***...***...***...***...***...***...***...***...***...***...*** * * * * * * * * ***...***...***...***...***...***...***...***...***...***...***...***...***...***...***...*** **************************************************************** *--------------------------------------------------------------- * | * |some usefull routine to manipulate strings * | *--------------------------------------------------------------- **************************************************************** integer function length(str) c return the string length without the blanks characters implicit integer (k-l) character *(*) str lmax=len(str) c search the last non blank character doi=lmax,1,-1 if(str(i:i).ne.' ')then length=i return end if end do length=lmax return end subroutine right(str,nch,res) c return the right string portion implicit integer (k-l) character *(*) str,res l=length(str) res=str(l-nch+1:l) return end subroutine intstr(num,str,l) c translate a integer value into string implicit integer(k-l) character *(*)str character *1 cifra(10) logical segno data cifra /'0','1','2','3','4','5','6','7','8','9'/ lun=len(str) if(lun.gt.30)stop segno=.false. c check the number sign if(num.lt.0)then segno=.true. num=abs(num) end if c translate the integer num doj=1,lun n=num/10**(lun-j) num=num-(n*10**(lun-j)) str(j:j)=cifra(n+1) end do c if the str length is fixed (l) if(l.ne.0)then call right(str,l,str) str=str(1:l) return end if c else delete zero characters l=lun 10 if(str(1:1).ne.'0')goto 20 str(1:l-1)=str(2:l) l=l-1 goto 10 20 if(segno)then str(2:l+1)=str(1:l) str(1:1)='-' str=str(1:l+1) else str=str(1:l) end if return end