/[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.1 by mocchiut, Tue Sep 23 07:20:20 2008 UTC revision 1.2 by mocchiut, Thu Dec 4 13:53:15 2008 UTC
# Line 1  Line 1 
1  C  C
2  C  Written by Emiliano Mocchiutti and Mirko Boezio  C  Written by Emiliano Mocchiutti and Mirko Boezio
3  C  C
4  C     * Version: 3.4.10 *  C     * Version: 3.4.11 *
5  C  C
6  C Changelog:  C Changelog:
7  C  C
8    C 3.4.10 - 3.4.11: (2008-12-04) Process always the data also in case of CRC errors.
9    C
10  C 3.4.09 - 3.4.10: (2006-10-19) Bug, crash when length is too big, fixed (introduced error code 143 = packet length problems);  C 3.4.09 - 3.4.10: (2006-10-19) Bug, crash when length is too big, fixed (introduced error code 143 = packet length problems);
11  C  C
12  C 3.4.08 - 3.4.09: (2006-09-28) XE is not always correctly found, fixed.  C 3.4.08 - 3.4.09: (2006-09-28) XE is not always correctly found, fixed.
# Line 143  C Line 145  C
145        integer seemcomp, seemfull, cberaw, yesisco, yesisfu,yesisra        integer seemcomp, seemfull, cberaw, yesisco, yesisfu,yesisra
146        integer ca50, ca50a, ca50b        integer ca50, ca50a, ca50b
147        integer firsttime        integer firsttime
148          integer scrcerr, sic, sicb
149  C      C    
150        real dedx1(11,96),dedx2(11,96),dedx3(11,96),dedx4(11,96)        real dedx1(11,96),dedx2(11,96),dedx3(11,96),dedx4(11,96)
151        real dedx1c(11,96),dedx2c(11,96),dedx3c(11,96),dedx4c(11,96)        real dedx1c(11,96),dedx2c(11,96),dedx3c(11,96),dedx4c(11,96)
# Line 295  C Line 298  C
298        ke = 0        ke = 0
299        chis = chi        chis = chi
300        icold = ic        icold = ic
301        DO i = 1, 60000        DO i = 1, 120000
302           vect(i) = 0           vect(i) = 0
303        enddo        enddo
304        do while (ke.eq.0)        do while (ke.eq.0)
# Line 803  C Line 806  C
806        endif        endif
807  C  C
808        if (check.ne.vect(length)) then        if (check.ne.vect(length)) then
809  C  c
810    c     try to process anyway if we have crc errors but only on the second time we have found our section
811    c
812             scrcerr = 0
813             sic = 0
814             sicb = 0
815             if ( headcor.ne.2 ) then
816    C    
817  C     clear vectors of that section in the common  C     clear vectors of that section in the common
818    C    
819                call clearsec
820  C  C
821           call clearsec              calselftrig(k,1) = check
822  C              calselftrig(k,2) = vect(length)
          calselftrig(k,1) = check  
          calselftrig(k,2) = vect(length)  
823  c          c        
824           merror(contr) = 132              merror(contr) = 132
825           chi = chi + 4              chi = chi + 4
826           lleng = 0              lleng = 0
827           length2 = 0              length2 = 0
828           length = 0              length = 0
829    c    
830                if (ke.eq.1.and.headcor.ne.2) then
831                   ic = 10
832    c     elseif (headcor.eq.2) then
833    c     contr = contr + 1            
834                endif
835                headcor = 1
836                ichc = ic - 1
837                if (iev.eq.dumpo)
838         &           print *,'crc is wrong ',ic,
839         &           ' search section ',contr,' coco = ',coco
840                goto 32    
841             else
842    c    
843    c     set some variables and try to go on
844  c  c
845           if (ke.eq.1.and.headcor.ne.2) then              merror(contr) = 132
846              ic = 10              scrcerr = 1
847           elseif (headcor.eq.2) then              sic = ic
848              contr = contr + 1                          sicb = icb
849    
850           endif           endif
          headcor = 1  
          ichc = ic - 1  
          if (iev.eq.dumpo)  
      &        print *,'crc is wrong ',ic,  
      &        ' search section ',contr,' coco = ',coco  
          goto 32      
851        else        else
852           chi = chi - 4           chi = chi - 4
853           if (chi.lt.0) chi = 0           if (chi.lt.0) chi = 0
# Line 842  C     Line 862  C    
862        call clearsec        call clearsec
863        do i = 1, 7        do i = 1, 7
864           icb = icb + 1           icb = icb + 1
865           auto(i) = vect(icb)           if ( icb.gt.120000 ) then
866    c     out of vector...
867                if (iev.eq.dumpo) then
868                   print *,' Run out of vect...'  
869                   goto 150
870                endif
871             endif
872             auto(i) = vect(icb)            
873        enddo        enddo
874  C      C    
875        st2c = 0        st2c = 0
# Line 859  C     Line 886  C    
886              chi = chi + 4              chi = chi + 4
887              if (iev.eq.dumpo)              if (iev.eq.dumpo)
888       &           print *,'raw lung 4'       &           print *,'raw lung 4'
889              lleng = 0              if ( scrcerr.eq.0 ) then
890              goto 150                 lleng = 0
891           else                               goto 150
892              if (k.eq.1) call CALRAW(vect,icb+1,length-1,dedx1)              endif
             if (k.eq.2) call CALRAW(vect,icb+1,length-1,dedx2)  
             if (k.eq.3) call CALRAW(vect,icb+1,length-1,dedx3)  
             if (k.eq.4) call CALRAW(vect,icb+1,length-1,dedx4)  
893           endif           endif
894    c     else              
895             if (k.eq.1) call CALRAW(vect,icb+1,length-1,dedx1)
896             if (k.eq.2) call CALRAW(vect,icb+1,length-1,dedx2)
897             if (k.eq.3) call CALRAW(vect,icb+1,length-1,dedx3)
898             if (k.eq.4) call CALRAW(vect,icb+1,length-1,dedx4)
899    c     endif
900           goto 50           goto 50
901        endif        endif
902  C      C    
# Line 879  c     Line 909  c    
909              chi = chi + 4              chi = chi + 4
910              if (iev.eq.dumpo)              if (iev.eq.dumpo)
911       &           print *,'compr lung 4'       &           print *,'compr lung 4'
912              lleng = 0              if ( scrcerr.eq.0 ) then
913              goto 150                 lleng = 0
914           else                 goto 150
915              icb = icb + 1              endif
916              calIItrig(k) = vect(icb)           endif
917              icb = icb + 1  c         else
918              calstriphit(k) = vect(icb)           icb = icb + 1
919              icb = icb + 1           if ( icb.gt.120000 ) then
920    c     out of vector...
921                if (iev.eq.dumpo) then
922                   print *,' Run out of vect...'  
923                   goto 150
924                endif
925             endif
926             calIItrig(k) = vect(icb)
927             icb = icb + 1
928             if ( icb.gt.120000 ) then
929    c     out of vector...
930                if (iev.eq.dumpo) then
931                    print *,' Run out of vect...'  
932                   goto 150
933                endif
934             endif
935             calstriphit(k) = vect(icb)
936             icb = icb + 1
937             if ( icb.gt.120000 ) then
938    c     out of vector...
939                if (iev.eq.dumpo) then
940                    print *,' Run out of vect...'  
941                   goto 150
942                endif
943             endif
944  C     FIRST CALORIMETER SIGNATURE:  CA50  C     FIRST CALORIMETER SIGNATURE:  CA50
945              icb = icb + 1           icb = icb + 1
946             if ( icb.gt.120000 ) then
947    c     out of vector...
948                if (iev.eq.dumpo) then
949                    print *,' Run out of vect...'  
950                   goto 150
951                endif
952             endif
953  C     SECOND CALORIMETER SIGNATURE:  CA50      C     SECOND CALORIMETER SIGNATURE:  CA50    
954              icb = icb + 1           icb = icb + 1
955             if ( icb.gt.120000 ) then
956    c     out of vector...
957                if (iev.eq.dumpo) then
958                    print *,' Run out of vect...'  
959                   goto 150
960                endif
961             endif
962  C     test is here!  C     test is here!
963              icb = icb + 1           icb = icb + 1
964              calDSPtaberr(k) = vect(icb)           if ( icb.gt.120000 ) then
965              icb = icb + 1  c     out of vector...
966              calevnum(k) = vect(icb)              if (iev.eq.dumpo) then
967              if (k.eq.1) call CALCOMPRESS(vect,icb+1,length-1,dedx1c,                  print *,' Run out of vect...'  
968       &           base1)                 goto 150
969              if (k.eq.2) call CALCOMPRESS(vect,icb+1,length-1,dedx2c,              endif
970       &           base2)           endif
971              if (k.eq.3) call CALCOMPRESS(vect,icb+1,length-1,dedx3c,           calDSPtaberr(k) = vect(icb)
972       &           base3)           icb = icb + 1
973              if (k.eq.4) call CALCOMPRESS(vect,icb+1,length-1,dedx4c,           if ( icb.gt.120000 ) then
974       &           base4)  c     out of vector...
975              goto 50              if (iev.eq.dumpo) then
976                    print *,' Run out of vect...'  
977                   goto 150
978                endif
979           endif           endif
980             calevnum(k) = vect(icb)
981             if (k.eq.1) call CALCOMPRESS(vect,icb+1,length-1,dedx1c,
982         &        base1,scrcerr)
983             if (k.eq.2) call CALCOMPRESS(vect,icb+1,length-1,dedx2c,
984         &        base2,scrcerr)
985             if (k.eq.3) call CALCOMPRESS(vect,icb+1,length-1,dedx3c,
986         &        base3,scrcerr)
987             if (k.eq.4) call CALCOMPRESS(vect,icb+1,length-1,dedx4c,
988         &        base4,scrcerr)
989             goto 50
990    c      endif
991        else if (test.eq.0) then        else if (test.eq.0) then
992           if (length2.gt.2257) then           if (length2.gt.2257) then
993              merror(contr) = 135              merror(contr) = 135
994              chi = chi + 4              chi = chi + 4
995              if (iev.eq.dumpo)              if (iev.eq.dumpo)
996       &           print *,'full lung 4'       &           print *,'full lung 4'
997              lleng = 0              if ( scrcerr.eq.0 ) then
998              goto 150                 lleng = 0
999           else                 goto 150
1000              icb = icb + 1              endif
1001              calIItrig(k) = vect(icb)           endif
1002              icb = icb + 1  c     else
1003              calstriphit(k) = vect(icb)           icb = icb + 1
1004              icb = icb + 1           if ( icb.gt.120000 ) then
1005    c     out of vector...
1006                if (iev.eq.dumpo) then
1007                   print *,' Run out of vect...'  
1008                   goto 150
1009                endif
1010             endif
1011             calIItrig(k) = vect(icb)
1012             icb = icb + 1
1013             if ( icb.gt.120000 ) then
1014    c     out of vector...
1015                if (iev.eq.dumpo) then
1016                   print *,' Run out of vect...'  
1017                   goto 150
1018                endif
1019             endif
1020             calstriphit(k) = vect(icb)
1021             icb = icb + 1
1022             if ( icb.gt.120000 ) then
1023    c     out of vector...
1024                if (iev.eq.dumpo) then
1025                   print *,' Run out of vect...'  
1026                   goto 150
1027                endif
1028             endif
1029  C     FIRST CALORIMETER SIGNATURE:  CA50  C     FIRST CALORIMETER SIGNATURE:  CA50
1030              icb = icb + 1           icb = icb + 1
1031             if ( icb.gt.120000 ) then
1032    c     out of vector...
1033                if (iev.eq.dumpo) then
1034                   print *,' Run out of vect...'  
1035                   goto 150
1036                endif
1037             endif
1038  C     SECOND CALORIMETER SIGNATURE:  CA50      C     SECOND CALORIMETER SIGNATURE:  CA50    
1039              icb = icb + 1           icb = icb + 1
1040             if ( icb.gt.120000 ) then
1041    c     out of vector...
1042                if (iev.eq.dumpo) then
1043                   print *,' Run out of vect...'  
1044                   goto 150
1045                endif
1046             endif
1047  C     test is here!  C     test is here!
1048              icb = icb + 1           icb = icb + 1
1049              calDSPtaberr(k) = vect(icb)           if ( icb.gt.120000 ) then
1050              icb = icb + 1  c     out of vector...
1051              calevnum(k) = vect(icb)              if (iev.eq.dumpo) then
1052              if (k.eq.1) call CALFULL(vect,icb+1,length-1,dedx1,                 print *,' Run out of vect...'  
1053       &           dedx1c,base1)                 goto 150
1054              if (k.eq.2) call CALFULL(vect,icb+1,length-1,dedx2,              endif
      &           dedx2c,base2)  
             if (k.eq.3) call CALFULL(vect,icb+1,length-1,dedx3,  
      &           dedx3c,base3)  
             if (k.eq.4) call CALFULL(vect,icb+1,length-1,dedx4,  
      &           dedx4c,base4)  
             goto 50  
1055           endif           endif
1056             calDSPtaberr(k) = vect(icb)
1057             icb = icb + 1
1058             if ( icb.gt.120000 ) then
1059    c     out of vector...
1060                if (iev.eq.dumpo) then
1061                   print *,' Run out of vect...'  
1062                   goto 150
1063                endif
1064             endif
1065             calevnum(k) = vect(icb)
1066             if (k.eq.1) call CALFULL(vect,icb+1,length-1,dedx1,
1067         &        dedx1c,base1,scrcerr)
1068             if (k.eq.2) call CALFULL(vect,icb+1,length-1,dedx2,
1069         &        dedx2c,base2,scrcerr)
1070             if (k.eq.3) call CALFULL(vect,icb+1,length-1,dedx3,
1071         &        dedx3c,base3,scrcerr)
1072             if (k.eq.4) call CALFULL(vect,icb+1,length-1,dedx4,
1073         &        dedx4c,base4,scrcerr)
1074             goto 50
1075    c     endif
1076        else        else
1077           merror(contr) = 136           merror(contr) = 136
1078           chi = chi + 4           chi = chi + 4
# Line 973  C     Line 1107  C    
1107              base(1,2*i,j) = base3(i,j)              base(1,2*i,j) = base3(i,j)
1108           enddo           enddo
1109        enddo        enddo
1110  C  C    
1111   150  continue   150  continue
1112  C  C    
1113        contr = contr + 1        contr = contr + 1
1114          
1115    c
1116    c     in case of crc error proceed as if we never processed this section
1117    c
1118          if ( scrcerr.eq.1 ) then
1119            
1120             chi = chi + 4
1121             lleng = 0
1122             length2 = 0
1123             length = 0
1124    c    
1125             headcor = 1
1126             ichc = sic - 1
1127             icb = sicb
1128             if (iev.eq.dumpo)
1129         &        print *,'crc is wrong ',sic,
1130         &        ' search section ',contr,' coco = ',coco
1131             goto 32    
1132    c
1133          endif
1134    
1135  C  C
1136  c     go on till we have found all the four sections  c     go on till we have found all the four sections
1137  c  c
# Line 1142  c Line 1297  c
1297        do j = 1,96        do j = 1,96
1298           do i = 1,11           do i = 1,11
1299              DEDX(I,J) = 0.              DEDX(I,J) = 0.
1300              dedx(i,j) = vect(k)              if ( k.le.120000 ) dedx(i,j) = vect(k)
1301              k = k + 1              k = k + 1
1302           enddo           enddo
1303        enddo        enddo
# Line 1151  c Line 1306  c
1306        END        END
1307    
1308  C------------------------------------------------  C------------------------------------------------
1309        SUBROUTINE CALCOMPRESS(vect,inf,sup,dedx,basse)        SUBROUTINE CALCOMPRESS(vect,inf,sup,dedx,basse,cer)
1310  C------------------------------------------------  C------------------------------------------------
1311    
1312        IMPLICIT NONE        IMPLICIT NONE
# Line 1168  C Line 1323  C
1323        INTEGER merror(4)        INTEGER merror(4)
1324        INTEGER contr        INTEGER contr
1325        integer stwerr(4),dumpo        integer stwerr(4),dumpo
1326        integer bit,bi        integer bit,bi,cer
1327  C  C
1328        REAL DEXY(2,NPLA,NCHA), dexyc(2,npla,ncha), base(2,npla,6)        REAL DEXY(2,NPLA,NCHA), dexyc(2,npla,ncha), base(2,npla,6)
1329        real calselftrig(4,7), calIItrig(4), calstriphit(4),        real calselftrig(4,7), calIItrig(4), calstriphit(4),
# Line 1221  c Line 1376  c
1376                 write(*,43)vect(i)                 write(*,43)vect(i)
1377              endif              endif
1378              merror(contr) = 139              merror(contr) = 139
1379              RETURN              if ( cer.eq.0 ) then
1380                   RETURN
1381                else
1382                   i = i + 1
1383                   goto 10
1384                endif
1385           endif           endif
1386        endif        endif
1387  C  C
# Line 1233  c Line 1393  c
1393           ipr = st - (ipl - 1) * 6 + 1           ipr = st - (ipl - 1) * 6 + 1
1394           i = i + 1           i = i + 1
1395           if (i.gt.sup) RETURN           if (i.gt.sup) RETURN
1396           basse(ipl,ipr) = vect(i)           if ( ipl.ge.1.and.ipl.le.11.and.ipr.ge.1.and.ipr.le.6)
1397         +        basse(ipl,ipr) = vect(i)            
1398  c          c        
1399   20      continue   20      continue
1400           if (i.gt.sup) RETURN           if (i.gt.sup) RETURN
# Line 1241  C Line 1402  C
1402           i = i + 1           i = i + 1
1403           if (i.gt.sup) RETURN           if (i.gt.sup) RETURN
1404           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
   
1405              goto 10              goto 10
1406           endif           endif
1407           ist = vect(i) + 1 + 16 * (ipr - 1)           ist = vect(i) + 1 + 16 * (ipr - 1)
1408           i = i + 1           i = i + 1
1409           if (i.gt.sup) RETURN           if (i.gt.sup) RETURN
1410           dedx(ipl,ist) = vect(i)           if ( ipl.ge.1.and.ipl.le.11.and.ist.ge.1.and.ist.le.96)
1411         +        dedx(ipl,ist) = vect(i)
1412           goto 20           goto 20
1413        else        else
1414  C  C
1415           st = IAND(vect(i),'00FF'x)           st = IAND(vect(i),'00FF'x)
1416           ipl = int(st/6) + 1           ipl = int(st/6) + 1
1417           ipr = st - (ipl - 1) * 6 + 1           ipr = st - (ipl - 1) * 6 + 1
1418           do j = 1,16           if ( ipl.ge.1.and.ipl.le.11 ) then
1419              i = i + 1              do j = 1,16
1420              if (i.gt.sup) RETURN                 i = i + 1
1421              ist = j + 16 * (ipr - 1)                 if (i.gt.sup) RETURN
1422              dedx(ipl,ist) = vect(i)                 ist = j + 16 * (ipr - 1)
1423           enddo                 if (ist.ge.1.and.ist.le.96) dedx(ipl,ist) = vect(i)
1424                enddo
1425             endif
1426           i = i + 1           i = i + 1
1427           if (i.gt.sup) RETURN           if (i.gt.sup) RETURN
1428           goto 10           goto 10
# Line 1272  C         Line 1435  C        
1435    
1436    
1437  C----------------------------------------------------------  C----------------------------------------------------------
1438        SUBROUTINE CALFULL(vect,inf,sup,dedx,dedxc,basse)        SUBROUTINE CALFULL(vect,inf,sup,dedx,dedxc,basse,cer)
1439  C--------------------------------------------------------------  C--------------------------------------------------------------
1440    
1441        IMPLICIT NONE        IMPLICIT NONE
# Line 1282  C--------------------------------------- Line 1445  C---------------------------------------
1445  C  C
1446        INTEGER*2 VECT(30000)        INTEGER*2 VECT(30000)
1447        INTEGER inf, sup        INTEGER inf, sup
1448        INTEGER i,j,k, iev        INTEGER i,j,k, iev, cer
1449        INTEGER contr        INTEGER contr
1450        integer stwerr(4),dumpo,merror(4)        integer stwerr(4),dumpo,merror(4)
1451  C  C
# Line 1306  C Line 1469  C
1469        do i = 1,11        do i = 1,11
1470           do j = 1,96           do j = 1,96
1471              DEDX(I,J) = 0.              DEDX(I,J) = 0.
1472              dedx(i,j) = vect(k)              if ( k.le.120000 ) dedx(i,j) = vect(k)
1473              k = k + 1              k = k + 1
1474           enddo           enddo
1475        enddo        enddo
1476  C  C
1477        call CALCOMPRESS(vect,k,sup,dedxc,basse)        call CALCOMPRESS(vect,k,sup,dedxc,basse,cer)
1478  C  C
1479   10   FORMAT(2X,'Status word:',2X,Z8)         10   FORMAT(2X,'Status word:',2X,Z8)      
1480    
Legend:
Removed from v.1.1  
changed lines
  Added in v.1.2
  ViewVC Help
Powered by ViewVC 1.1.23