/[PAMELA software]/chewbacca/PamOffLineSW/forroutines/calorimeter/calunpack.for
ViewVC logotype

Diff of /chewbacca/PamOffLineSW/forroutines/calorimeter/calunpack.for

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.2 by mocchiut, Thu Dec 4 13:53:15 2008 UTC revision 1.8 by mocchiut, Thu Dec 24 11:20:53 2009 UTC
# Line 123  c      PARAMETER (START=300,SEC1ST=1200) Line 123  c      PARAMETER (START=300,SEC1ST=1200)
123  c      PARAMETER (START=500,SEC1ST=1200)  c      PARAMETER (START=500,SEC1ST=1200)
124        PARAMETER (SEC1ST=1200)        PARAMETER (SEC1ST=1200)
125        PARAMETER (NPLA=22,NCHA=96,LENSEV=NPLA*NCHA)        PARAMETER (NPLA=22,NCHA=96,LENSEV=NPLA*NCHA)
126        PARAMETER (ival='FFFF'x)  c      PARAMETER (ival=-32768)
127    c      PARAMETER (ival='FFFF'x)
128  C  C
129  C Normal variables definition  C Normal variables definition
130  C  C
# Line 172  C Line 173  C
173  C          C        
174  C Begin !  C Begin !
175  C  C
176    c      dumpo = iev
177        start = 320        start = 320
178        firsttime = 1        firsttime = 1
179        SOGLIA0 = 70        SOGLIA0 = 70
180          sic = 0
181          sicb = 0
182   2    continue   2    continue
183  C  C
184  C     input length must be > 0, if not go out with error code 142  C     input length must be > 0, if not go out with error code 142
# Line 186  C Line 190  C
190           enddo           enddo
191           goto 999           goto 999
192        endif        endif
193    
194          do bit = 0, 15
195             ival = ibset(ival,bit)
196          enddo
197    c      print *,' IVAL ',IVAL
198    c      write(*,22)IVAL
199  C  C
200  C     no debug informations  C     no debug informations
201  C  C
# Line 193  C Line 203  C
203  C  C
204  C     DEBUG: PRINT OUT THE INPUT VECTOR  C     DEBUG: PRINT OUT THE INPUT VECTOR
205  C  C
206        if (iev.eq.dumpo) then  c      dumpo=iev
207           do l=1,lung  c      if (iev.eq.dumpo) then
208              write(*,17)l,vecta(l)  c         do l=1,lung
209           enddo  c            write(*,17)l,vecta(l)
210        endif  c         enddo
211  C      dumpo = iev  c      endif
212  C  C
213  C     DETERMINE LENGTH IN WORDS FROM LENGTH IN BYTES  C     DETERMINE LENGTH IN WORDS FROM LENGTH IN BYTES
214  C  C
# Line 295  C Line 305  C
305  c  c
306   32   continue   32   continue
307  C  C
308          if ( ic .lt. 1 ) then
309             if (dumpo.eq.iev) print *,' AGH IC = ',IC      
310             ic = 1
311          endif
312          if ( icsave .lt. 0 ) then
313             if (dumpo.eq.iev) print *,' AGH ICSAVE = ',ICSAVE      
314             icsave = 0
315          endif
316    C
317        ke = 0        ke = 0
318        chis = chi        chis = chi
319        icold = ic        icold = ic
# Line 835  c     contr = contr + 1             Line 854  c     contr = contr + 1            
854              headcor = 1              headcor = 1
855              ichc = ic - 1              ichc = ic - 1
856              if (iev.eq.dumpo)              if (iev.eq.dumpo)
857       &           print *,'crc is wrong ',ic,       &           print *,' A crc is wrong ',ic,
858       &           ' search section ',contr,' coco = ',coco       &           ' search section ',contr,' coco = ',coco
859              goto 32                  goto 32    
860           else           else
# Line 1111  C     Line 1130  C    
1130   150  continue   150  continue
1131  C      C    
1132        contr = contr + 1        contr = contr + 1
1133          
1134    c
1135    c should never happen that we find MORE than 4 sections..
1136    c
1137          if (contr.gt.100) then
1138             if (iev.eq.dumpo)
1139         &        print *,'contr ????????????? ',contr
1140    
1141             me = 1
1142             do i = 1, 4
1143                merror(i) = 129            
1144                e2(i) = 0            
1145                stwerr(i) = 0
1146             enddo
1147             call clearall
1148             goto 999
1149          endif
1150  c  c
1151  c     in case of crc error proceed as if we never processed this section  c     in case of crc error proceed as if we never processed this section
1152  c  c
# Line 1126  c     Line 1161  c    
1161           ichc = sic - 1           ichc = sic - 1
1162           icb = sicb           icb = sicb
1163           if (iev.eq.dumpo)           if (iev.eq.dumpo)
1164       &        print *,'crc is wrong ',sic,       &        print *,' B crc is wrong ',sic,
1165       &        ' search section ',contr,' coco = ',coco       &        ' search section ',contr,' coco = ',coco
1166           goto 32               goto 32    
1167  c  c
# Line 1253  c Line 1288  c
1288                 enddo                 enddo
1289              enddo                enddo  
1290           endif           endif
1291           do l=1,lung  c         do l=1,lung
1292              write(*,17)l,vecta(l)  c            write(*,17)l,vecta(l)
1293           enddo  c         enddo
1294        endif        endif
1295        iev = iev + 1              iev = iev + 1      
1296        RETURN        RETURN
# Line 1352  C Line 1387  C
1387        i = inf        i = inf
1388  c  c
1389   10   continue   10   continue
1390        if (i.gt.sup) then        if (i.gt.sup.or.i.gt.120000) then
1391           RETURN           RETURN
1392        endif        endif
1393  C  C
# Line 1392  c Line 1427  c
1427           ipl = int(st/6) + 1           ipl = int(st/6) + 1
1428           ipr = st - (ipl - 1) * 6 + 1           ipr = st - (ipl - 1) * 6 + 1
1429           i = i + 1           i = i + 1
1430           if (i.gt.sup) RETURN           if (i.gt.sup.or.i.gt.120000) RETURN
1431           if ( ipl.ge.1.and.ipl.le.11.and.ipr.ge.1.and.ipr.le.6)           if ( ipl.ge.1.and.ipl.le.11.and.ipr.ge.1.and.ipr.le.6)
1432       +        basse(ipl,ipr) = vect(i)                   +        basse(ipl,ipr) = vect(i)            
1433  c          c        
1434   20      continue   20      continue
1435           if (i.gt.sup) RETURN           if (i.gt.sup.or.i.gt.120000) RETURN
1436  C  C
1437           i = i + 1           i = i + 1
1438           if (i.gt.sup) RETURN           if (i.gt.sup.or.i.gt.120000) RETURN
1439           if ((vect(i)+1).gt.16.or.(vect(i)+1).lt.1) then           if ((vect(i)+1).gt.16.or.(vect(i)+1).lt.1) then
1440              goto 10              goto 10
1441           endif           endif
1442           ist = vect(i) + 1 + 16 * (ipr - 1)           ist = vect(i) + 1 + 16 * (ipr - 1)
1443           i = i + 1           i = i + 1
1444           if (i.gt.sup) RETURN           if (i.gt.sup.or.i.gt.120000) RETURN
1445           if ( ipl.ge.1.and.ipl.le.11.and.ist.ge.1.and.ist.le.96)           if ( ipl.ge.1.and.ipl.le.11.and.ist.ge.1.and.ist.le.96)
1446       +        dedx(ipl,ist) = vect(i)       +        dedx(ipl,ist) = vect(i)
1447           goto 20           goto 20
# Line 1418  C Line 1453  C
1453           if ( ipl.ge.1.and.ipl.le.11 ) then           if ( ipl.ge.1.and.ipl.le.11 ) then
1454              do j = 1,16              do j = 1,16
1455                 i = i + 1                 i = i + 1
1456                 if (i.gt.sup) RETURN                 if (i.gt.sup.or.i.gt.120000) RETURN
1457                 ist = j + 16 * (ipr - 1)                 ist = j + 16 * (ipr - 1)
1458                 if (ist.ge.1.and.ist.le.96) dedx(ipl,ist) = vect(i)                 if (ist.ge.1.and.ist.le.96) dedx(ipl,ist) = vect(i)
1459              enddo              enddo
1460           endif           endif
1461           i = i + 1           i = i + 1
1462           if (i.gt.sup) RETURN           if (i.gt.sup.or.i.gt.120000) RETURN
1463           goto 10           goto 10
1464  C          C        
1465        endif        endif
Legend:
Removed from v.1.2  
changed lines
  Added in v.1.8
  ViewVC Help
Powered by ViewVC 1.1.23