C------------------------------------------------ PROGRAM DATA2NTP C------------------------------------------------ IMPLICIT NONE C CHARACTER*40 file CHARACTER*9 cho CHARACTER*1 ANSW CHARACTER*40 file_name3 C INTEGER NPLA, NCHA, LENSEV PARAMETER (NPLA=22,NCHA=96,LENSEV=NPLA*NCHA) integer vai, inizio, kl integer numev, lung, me integer*1 mah integer*4 evnum, systime, len integer RUNERROR, PERR(4), NERROR, merror(4) C C Normal variables definition C INTEGER FFD, est1, est2, lu1, lu,lu2,lu3 C INTEGER i, j, kk, ival, silofa, p,ik INTEGER istat, ierr, icycle, bi, bit C INTEGER*2 VECT(20000), estatus INTEGER*4 st3, word1 c integer*1 vecta(40000), vectb(40000),word(3), savewo(3) C integer*8 buffer(2), obt1,obt2,obt3,obt4,obt,obtold integer calcrc, vet,vec C integer*2 check, crc, stwer(4) C INTEGER ic, k, l, fake INTEGER status, CONTR INTEGER inf, sup integer dst1, dst2 integer*1 dstatus INTEGER*2 length, length2 INTEGER lundata, iosop INTEGER*2 st1, st2, st4 INTEGER lrec PARAMETER (lrec=8190) integer irec,iev,iev2, iev3 real RVECT(50) REAL calped(4,11,96), calgood(4,11,96), calthr(4,11,6) REAL calrms(4,11,96), calbase(4,11,6), calvar(4,11,6) REAL calpuls(4,11,96) real calselftrig(4,7), calIItrig(4), calstriphit(4) real calDSPtaberr(4), calevnum(4) REAL DEXY(2,NPLA,NCHA), dexyc(2,npla,ncha), base(2,npla,6) real perror(4), cperror(4) real pperror(4) integer pstwerr(4) integer cstwerr(4) integer stwerr(4) integer dump, fat integer calev0, oldcalev0, calev1,oldcalev1,calevv2, & oldcalev2,calev3,oldcalev3 COMMON / evento / IEV, stwerr, perror, & dexy,dexyc,base, & calselftrig,calIItrig, & calstriphit,calDSPtaberr,calevnum save / evento / COMMON / calib / IEV2, cstwerr, cperror, & calped, calgood, calthr, calrms, & calbase, & calvar save / calib / COMMON / calpul / IEV3, pstwerr, pperror, & calpuls save / calpul / c COMMON / VARIE / dump, CONTR, merror SAVE / VARIE / COMMON / HEADER / buffer SAVE / HEADER / REAL hmemor(9000000) integer Iquest(100) COMMON /pawc/hmemor Common /QUEST/ Iquest CALL HLIMIT(9000000) Iquest(10) = 256000 c Iquest(10) = 128000 calev0=0; calev1=0; calevv2=0; calev3=0; C C Begin ! C C PRINT *,'File to save? ' READ(*,904)file_name3 print *,file_name3 C C Histos creation C CALL HROPEN(59,'Event','/wizard3/pamela/integr/'// + file_name3,'nqe',lrec,istat) CALL HBNT(1,'Pamela Calo',' ') CALL HBNT(2,'Pamela data',' ') CALL HBNT(3,'Pamela puls',' ') CALL HBSET('BSIZE',lrec,ierr) *** /* Book ntuple variables */ CALL HBNAME(1,'calib',iev2,'iev2:I,cstwerr(4):I,cperror(4):R,'// & 'calped(4,11,96):R,'// & 'calgood(4,11,96):R,calthr(4,11,6):R,'// & 'calrms(4,11,96):R,calbase(4,11,6):R,calvar(4,11,6)') CALL HBNAME(2,'evento',iev,'iev:I,stwerr(4):I,perror(4):R,'// & 'dexy(2,22,96):R,'// & 'dexyc(2,22,96):R,base(2,22,6):R,'// & 'calselftrig(4,7):R,'// & 'calIItrig(4):R,'// & 'calstriphit(4):R,calDSPtaberr(4):R,calevnum(4):R') CALL HBNAME(3,'calpul',iev3,'iev3:I,pstwerr(4):I,pperror(4):R,'// & 'calpuls(4,11,96):R') C iev = 0 iev2 = 0 iev3 = 0 c 7 continue RUNERROR=0 ! error variable PRINT *,'File to read? ' READ(*,905)file print *,file numev = 0 PRINT *,'Number of fafede? ' READ(*,906)numev print *,numev numev = numev + 1 inizio = 1 PRINT *,'Where to start? ' READ(*,906)inizio print *,inizio 906 FORMAT(I6) 905 FORMAT(A40) c lundata = 44 c OPEN(UNIT=lundata,FILE='/wizard3/pamela/integr/'//file & ,STATUS='OLD', FORM='UNFORMATTED',ACCESS='DIRECT',ERR=50 & ,recl=4) C PRINT *,'Data, pedestal, pulse or all? ' READ(*,903)cho print *,cho C dump = -1 PRINT *,'Any iev to be dumped out (number/[-1])? ' READ(*,906)dump print *,dump if (dump.ne.-1) dump = dump - 1 c fat = 39312 PRINT *,'Any fafede type (i.e. 10,07,18,..) to be dumped'// & ' out (number/[-1])? ' READ(*,29)fat write(*,29)fat 29 format(Z4) C 903 FORMAT(A9) 904 FORMAT(A40) C ffd=FNum(lundata) ! take the file descriptor number C contr = 1 call azero(calped,4*11*96) call azero(calgood,4*11*96) call azero(calthr,4*11*96) call azero(calrms,4*11*96) call azero(calbase,4*11*6) call azero(calvar,4*11*6) call azero(calpuls,4*11*96) call azero(dexy,4*11*96) call azero(dexyc,4*11*96) call azero(base,4*11*6) call azero(calselftrig,4*7) call azero(calIItrig,4) call azero(calstriphit,4) call azero(calDSPtaberr,4) call azero(calevnum,4) c obt = 0 obtold = 0 do l = 1,4 stwer(l) = 0 perr(l) = 0 cstwerr(l) = 0 cperror(l) = 0. pstwerr(l) = 0 pperror(l) = 0. stwerr(l) = 0 perror(l) = 0. enddo C C Read event: use C readevent routine, it reads words of 32 bits C search the first FAFEDE of the file: C do p=1,20000 vect(p) = 0 enddo silofa = 0 word(1) = 0 word(2) = 0 word(3) = 0 c vai = 0 do while (vai.lt.inizio) do i = 1, 3 fake = 0 runerror = 0 call reads(fake,runerror,ffd) if (runerror.eq.-1.or.runerror.eq.1) then print *,'Error reading file - no FAFEDE found!' goto 50 endif word(i) = fake enddo c silofa = 0 do while (silofa.eq.0) call fafede(word,silofa) if (silofa.eq.1) then savewo(1)=word(1) savewo(2)=word(2) savewo(3)=word(3) vai = vai + 1 else runerror = 0 fake = 0 call reads(fake,runerror,ffd) word(1) = word(2) word(2) = word(3) word(3) = fake endif enddo enddo c C ok, now for all the events search the next FAFEDE c do j = (inizio+1), numev i = 0 lu = 39999 silofa = 0 c i = i + 1 vecta(i) = savewo(1) i = i + 1 vecta(i) = savewo(2) i = i + 1 vecta(i) = savewo(3) runerror = 0 fake = 0 word(1) = 0 word(2) = 0 word(3) = 0 do ik = 1, 3 call reads(fake,runerror,ffd) if (runerror.eq.-1.or.runerror.eq.1) then print *,'Error reading file - no FAFEDE found!' goto 50 endif word(ik) = fake enddo do while (silofa.eq.0) c c go out before running out of file! c if (j.ge.numev.and.i.ge.lu) then silofa = 2 goto 77 endif c call fafede(word,silofa) 77 CONTINUE if (silofa.eq.1) then savewo(1)=word(1) savewo(2)=word(2) savewo(3)=word(3) elseif (silofa.eq.0) then call reads(fake,runerror,ffd) i = i + 1 vecta(i) = word(1) word(1) = word(2) word(2) = word(3) word(3) = fake c c extract length of the packet (first two bytes) c if (i.eq.13) then lu1 = 0 do bit=0, 7 bi = ibits(vecta(i),bit,1) if (bi.eq.1) then lu1 = lu1 + 2**(bit+16) endif enddo endif if (i.eq.14) then lu2 = 0 do bit=0, 7 bi = ibits(vecta(i),bit,1) if (bi.eq.1) then lu2 = lu2 + 2**(bit+8) endif enddo endif if (i.eq.15) then 108 format(2X,'numero ',2x,i5,2x,' valore ',2x,Z8) 109 format(2X,'i13-15 ',Z8) lu3 = 0 do bit=0, 7 bi = ibits(vecta(i),bit,1) if (bi.eq.1) then lu3 = lu3 + 2**(bit) endif enddo lu = (lu1 + lu2 + lu3) + 16 if (lu.lt.16) then print *,'Warning: length ',lu goto 9 endif endif c c extract the OBT c if (i.eq.9) then obt1 = 0 do bit=0, 7 bi = ibits(vecta(i),bit,1) if (bi.eq.1) then obt1 = obt1 + 2**(bit+32) endif enddo endif if (i.eq.10) then obt2 = 0 do bit=0, 7 bi = ibits(vecta(i),bit,1) if (bi.eq.1) then obt2 = obt2 + 2**(bit+16) endif enddo endif if (i.eq.11) then obt3 = 0 do bit=0, 7 bi = ibits(vecta(i),bit,1) if (bi.eq.1) then obt3 = obt3 + 2**(bit+8) endif enddo endif if (i.eq.12) then obt4 = 0 do bit=0, 7 bi = ibits(vecta(i),bit,1) if (bi.eq.1) then obt4 = obt4 + 2**(bit) endif enddo obtold = obt obt = obt1 + obt2 + obt3 + obt4 endif endif enddo C c print *,'lunghezza i ',i c print *,'lunghezza lu ',lu c write(*,13)vecta(16) if ( abs(obt-obtold).le.5 ) then print *,'' print *,'WARNING1 OBT = ',obt,' OBT OLD = ',obtold print *,'' endif if ( (obt-obtold).lt.0 ) then print *,'' print *,'WARNING2 OBT = ',obt,' OBT OLD = ',obtold print *,'' endif calcrc = 1 vec=-1 buffer(1) = 0 buffer(2) = 0 do vet=16,1,-1 vec = vec+1 if (vec.gt.7) then do bit=0, 7 bi = 0 bi = ibits(vecta(vet),bit,1) if (bi.eq.1) then buffer(1)=ibset(buffer(1),bit+8*vec) else buffer(1)=ibclr(buffer(1),bit+8*vec) endif enddo else do bit=0, 7 bi = 0 bi = ibits(vecta(vet),bit,1) if (bi.eq.1) then buffer(2)=ibset(buffer(2),bit+8*vec) else buffer(2)=ibclr(buffer(2),bit+8*vec) endif enddo endif enddo c write(*,14)buffer(1) c write(*,14)buffer(2) calcrc = 1 call testcrc(vecta(16),calcrc) c print *,'calcrc ',calcrc c if (vecta(4).ne.vecta(5).or.calcrc.ne.0) then print *,'Packet header corrupted!' iev = iev + 1 goto 666 endif if (i.lt.lu) &print *,'WARNING packet length shorter than expected, CRC errors?' c if (lu.gt.40000) then print *,'WARNING packet length problems, CRC errors?' c c goto 666 c lu = i endif if (lu.gt.40000) then c if (vecta(4).eq.24) iev=iev+1 c goto 666 lu = 40000 endif c do p = 1, 40000 vectb(p) = 0 if (p.gt.lu) then vecta(p) = 0 continue endif if (p.gt.16) vectb(p-16)=vecta(p) enddo C c write(*,28)fat,lu c print *,' fat ',fat,' vecta(4) ',vecta(4) if (vecta(4).eq.fat.or.fat.eq.39321.or.vecta(4).eq.-127) then c if (vecta(4).eq.fat.or.fat.eq.153) then c if (vecta(4).eq.fat.or.fat.eq.153.or.fat.eq.129) then do l=1,lu write(*,17)l,vecta(l) 17 FORMAT(2X,'Elemento:',2X,I6,2X,' word:',2X,Z8) enddo endif c print *,'############' write(*,28)vecta(4),j-1,obt print *,'############' 28 format(' # FAFEDE',Z2,' # pkt no ',I6,' OBT ',I16) C c c do l=1,lu-18 c if ( vectb(l).ne.0 ) then c if ( vectb(l).le.15.and.vectb(l).gt.0 ) then c if ( vectb(l).eq.1 ) write(*,179) c if ( vectb(l).eq.2 ) write(*,180) c if ( vectb(l).eq.3 ) write(*,181) c if ( vectb(l).eq.4 ) write(*,182) c if ( vectb(l).eq.5 ) write(*,183) c if ( vectb(l).eq.6 ) write(*,184) c if ( vectb(l).eq.7 ) write(*,185) c if ( vectb(l).eq.8 ) write(*,186) c if ( vectb(l).eq.9 ) write(*,187) c if ( vectb(l).eq.10 ) write(*,188) c if ( vectb(l).eq.11 ) write(*,189) c if ( vectb(l).eq.12 ) write(*,190) c if ( vectb(l).eq.13 ) write(*,191) c if ( vectb(l).eq.14 ) write(*,192) c if ( vectb(l).eq.15 ) write(*,193) c else c write(*,177) vectb(l) c endif c else c write(*,178) c endif c 177 FORMAT(Z2) c 178 FORMAT('00') c 179 FORMAT('01') c 180 FORMAT('02') c 181 FORMAT('03') c 182 FORMAT('04') c 183 FORMAT('05') c 184 FORMAT('06') c 185 FORMAT('07') c 186 FORMAT('08') c 187 FORMAT('09') c 188 FORMAT('0A') c 189 FORMAT('0B') c 190 FORMAT('0C') c 191 FORMAT('0D') c 192 FORMAT('0E') c 193 FORMAT('0F') c enddo c endif c if (cho.eq.'pulse'.or.cho.eq.'all') then if (vecta(4).eq.8.or.vecta(4).eq.9) then call calpulse(vectb,lu,me) print *,'me = ',me me = 0 do i = 1, 4 stwerr(i) = pstwerr(i) perror(i) = pperror(i) enddo iev = iev3 else me = 1 endif endif c if (cho.eq.'pedestal'.or.cho.eq.'all') then if (vecta(4).eq.24) then call calpedestal(vectb,lu,me) me = 0 do i = 1, 4 stwerr(i) = cstwerr(i) perror(i) = cperror(i) enddo iev = iev2 else me = 1 endif endif c if (cho.eq.'data'.or.cho.eq.'all'.or.cho.eq.'debug') then if (vecta(4).eq.16) then call calunpack(vectb,lu,me) me = 0 else me = 1 call clearall endif endif c if (cho.eq.'house'.or.cho.eq.'all') then if (vecta(4).eq.7) then print *,'End of run!' me = 0 endif endif c if (me.eq.0) then print *,'*****************************************************' print *,' FAFEDE number: ',j-1 print *,'*****************************************************' C c iev = iev + 1 c iev2 = iev do l = 1, 4 st4 = 0 st4 = IAND(stwerr(l),'00FF'x) c if (st4.ne.0) then write(*,112) l,stwerr(l) do bit=0, 17 c bi = ibits(st4,bit,1) bi = ibits(stwerr(l),bit,1) if (bit.eq.0.and.bi.ne.0) & print *,' ---> CRC error' if (bit.eq.1.and.bi.ne.0) & print *,' ---> Execution error' if (bit.eq.2.and.bi.ne.0) & print *,' ---> CMD length error' if (bit.eq.3.and.bi.ne.0) & print *,' ---> RAW mode' if (bit.eq.4.and.bi.ne.0) & print *,' ---> Latch up alarm' if (bit.eq.5.and.bi.ne.0) & print *,' ---> Temp. alarm' if (bit.eq.6.and.bi.ne.0) & print *,' ---> DSP ack error' C if (bit.eq.16.and.bi.ne.0) & print *,' Acq. in compress mode, view: ',l if (bit.eq.17.and.bi.ne.0) & print *,' Acq. in full mode, view: ',l C enddo 112 format(1X,'View ',I1,' header: ',Z8) c endif if (perror(l).eq.128.) & print *,'View or command not recognized, searching section',l if (perror(l).eq.129.) & print *,'Missing section ',l,' !' if (perror(l).eq.130.) & print *,'RAW MODE COMMAND! ',l if (perror(l).eq.131.) & print *,'--- Length problems! --- section ',l if (perror(l).eq.132.) & print *,'--- CRC errors! --- section ',l if (perror(l).eq.133.) & print *,'Problems with length of view: ',l, & ' in raw mode length' if (perror(l).eq.134.) & print *,'Problems with length of view: ',l, & ' in compress mode length' if (perror(l).eq.135.) & print *,'Problems with length of view: ',l, & ' in full mode length' if (perror(l).eq.136.) & print *,'Acq mode problems with view: ',l c if (perror(l).eq.137.) c & print *,'Acq in compress mode, view: ',l c if (perror(l).eq.138.) c & print *,'Acq in full mode, view: ',l if (perror(l).eq.139.) & print *,'Problems with coding, view: ',l if (perror(l).eq.140.) & print *,'CHKSUM wrong, pedestal view: ',l if (perror(l).eq.141.) & print *,'CHKSUM wrong, thresholds view: ',l if (perror(l).eq.142.) & print *,'Packet length is zero! skipped: ',l enddo C print *,' ' c if (iev.eq.0) then c print *,' +++ RECORDED +++ iev = ',iev2 c else print *,' +++ RECORDED +++ iev = ',iev c endif if (calevnum(1).eq.0..or. & calevnum(2).eq.0..or. & calevnum(3).eq.0..or. & calevnum(4).eq.0.) then print *,'-| ZERO COUNTER |- ' print *,' 1 ',calevnum(1) print *,' 2 ',calevnum(2) print *,' 3 ',calevnum(3) print *,' 4 ',calevnum(4) endif print *,' ' print *,'*****************************************************' c if (cho.eq.'debug') then c call prevento c goto 50 c endif oldcalev0 = calev0 calev0 = calevnum(1) oldcalev1 = calev1 calev1 = calevnum(2) oldcalev2 = calevv2 calevv2 = calevnum(3) oldcalev3 = calev3 calev3 = calevnum(4) if ( (calev0+calev3-calevv2-calev1).ne.0 ) then print *,'0 Event 0: ',calev0 print *,'1 Event 0: ',calev1 print *,'2 Event 0: ',calevv2 print *,'3 Event 0: ',calev3 endif if ( (calev0 - oldcalev0 - 1).ne.0.or. & (calev1 - oldcalev1 - 1).ne.0.or. & (calevv2 - oldcalev2 - 1).ne.0.or. & (calev3 - oldcalev3 - 1).ne.0 ) then print *,'0 Event -1: ',oldcalev0 print *,'0 Event 0: ',calev0 print *,'1 Event -1: ',oldcalev1 print *,'1 Event 0: ',calev1 print *,'2 Event -1: ',oldcalev2 print *,'2 Event 0: ',calevv2 print *,'3 Event -1: ',oldcalev3 print *,'3 Event 0: ',calev3 endif if (cho.eq.'pedestal') then call hfnt(1) elseif (cho.eq.'data') then call hfnt(2) elseif (cho.eq.'pulse') then call hfnt(3) elseif (cho.eq.'all') then call hfnt(1) call hfnt(2) call hfnt(3) endif contr = 1 c endif C 666 continue c do p=1,40000 vecta(p) = 0 enddo do l = 1,4 perror(l) = 0. stwerr(l) = 0 stwer(l) = 0 perr(l) = 0 stwerr(l) = 0 perror(l) = 0. enddo call clearall C if (silofa.eq.2) goto 50 c 9 continue c enddo 10 FORMAT(2X,'Numero ',2X,I4,2X,' valore: ',Z8) 13 FORMAT(2X,'CRC dai dati ',Z8) 14 FORMAT(2X,'CRC calcolato ',Z128) 50 continue C CLOSE (44) c print *,'Any other data file (Y/N)?' READ(*,51)answ print *,answ 51 format(A1) IF (ANSW.EQ.'Y'.or.answ.eq.'y') GOTO 7 c c /* Save histograms */ c CALL HROUT(0,icycle,' ') CALL HREND('Event') CLOSE (59) C C end C 52 continue RETURN END