/[PAMELA software]/DarthVader/TrackerLevel2/src/F77/functionspfa.f
ViewVC logotype

Diff of /DarthVader/TrackerLevel2/src/F77/functionspfa.f

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

revision 1.22 by pam-fi, Tue Sep 4 09:47:49 2007 UTC revision 1.26 by mocchiut, Tue Aug 11 12:58:25 2009 UTC
# Line 8  Line 8 
8  *  *
9  *     integer function npfastrips(ic,angle)  *     integer function npfastrips(ic,angle)
10  *  *
11    *     -----------------------------------------------------------------
12    *     p.f.a.
13    *     -----------------------------------------------------------------
14  *     real function pfaeta(ic,angle)  *     real function pfaeta(ic,angle)
15  *     real function pfaetal(ic,angle)  *     real function pfaetal(ic,angle)
16  *     real function pfaeta2(ic,angle)  *     real function pfaeta2(ic,angle)
# Line 15  Line 18 
18  *     real function pfaeta4(ic,angle)  *     real function pfaeta4(ic,angle)
19  *     real function cog(ncog,ic)  *     real function cog(ncog,ic)
20  *  *
21    *     -----------------------------------------------------------------
22    *     risoluzione spaziale media, stimata dalla simulazione (samuele)
23    *     -----------------------------------------------------------------
24    *     FUNCTION risxeta2(angle)
25    *     FUNCTION risxeta3(angle)
26    *     FUNCTION risxeta4(angle)
27    *     FUNCTION risyeta2(angle)
28    *     FUNCTION risy_cog(angle)
29    *     FUNCTION risx_cog(angle)
30    *     real function riseta(iview,angle)
31    *     -----------------------------------------------------------------
32    *     fattore moltiplicativo per tenere conto della dipendenza della
33    *     risoluzione dal rumore delle strip
34    *     -----------------------------------------------------------------
35  *     real function fbad_cog(ncog,ic)  *     real function fbad_cog(ncog,ic)
36  *     real function fbad_eta(ic,angle)  *     real function fbad_eta(ic,angle)
37  *  *
38  *     real function riseta(iview,angle)  *     -----------------------------------------------------------------
39  *     FUNCTION risxeta2(x)  *     NUOVO APPROCCIO PER LA STIMA DELLA RISOLUZIONE
40  *     FUNCTION risxeta3(x)  *     -----------------------------------------------------------------
41  *     FUNCTION risxeta4(x)  *     real function riscogtheor(ncog,ic)
42  *     FUNCTION risyeta2(x)  *     real function risetatheor(ncog,ic,angle)
 *     FUNCTION risy_cog(x)  
 *     FUNCTION risx_cog(x)  
43  *  *
44    *     -----------------------------------------------------------------
45    *     correzione landi
46    *     -----------------------------------------------------------------
47  *     real function pfacorr(ic,angle)  *     real function pfacorr(ic,angle)
48  *  *
49  *     real function effectiveangle(ang,iview,bbb)  *     real function effectiveangle(ang,iview,bbb)
# Line 70  c     here bbb is the y component of the Line 88  c     here bbb is the y component of the
88           by   = bbb           by   = bbb
89           if(iview.eq.12) angx = -1. * ang           if(iview.eq.12) angx = -1. * ang
90           if(iview.eq.12) by   = -1. * bbb           if(iview.eq.12) by   = -1. * bbb
91           tgtemp  = tan(ang*acos(-1.)/180.) + pmuH_h*by*0.00001  cc         tgtemp  = tan(ang*acos(-1.)/180.) + pmuH_h*by*0.00001 !ORRORE!!
92             tgtemp  = tan(angx*acos(-1.)/180.) + pmuH_h*by*0.00001
93    
94        elseif(mod(iview,2).eq.1)then        elseif(mod(iview,2).eq.1)then
95  c     =================================================  c     =================================================
# Line 441  cc            print*,pfaeta2(ic,angle) Line 460  cc            print*,pfaeta2(ic,angle)
460                            
461        endif        endif
462                
463   100  return  c 100  return
464          return
465        end        end
466    
467  *** * * * *** * * * *** * * * *** * * * *** * * * *** * * * ***  *** * * * *** * * * *** * * * *** * * * *** * * * *** * * * ***
# Line 488  cc            print*,VIEW(ic),angle,pfae Line 508  cc            print*,VIEW(ic),angle,pfae
508                            
509        endif        endif
510                
511   100  return  c 100  return
512          return
513        end        end
514  *** * * * *** * * * *** * * * *** * * * *** * * * *** * * * ***  *** * * * *** * * * *** * * * *** * * * *** * * * *** * * * ***
515  c      real function riseta(ic,angle)  c      real function riseta(ic,angle)
# Line 538  c      if(mod(int(VIEW(ic)),2).eq.1)then Line 559  c      if(mod(int(VIEW(ic)),2).eq.1)then
559        endif        endif
560    
561    
562   100  return  c 100  return
563          return
564        end        end
565    
566  *** * * * *** * * * *** * * * *** * * * *** * * * *** * * * ***  *** * * * *** * * * *** * * * *** * * * *** * * * *** * * * ***
# Line 551  c      if(mod(int(VIEW(ic)),2).eq.1)then Line 573  c      if(mod(int(VIEW(ic)),2).eq.1)then
573  *     resolution.  *     resolution.
574  *     It calls the function FBAD_COG(NCOG,IC),  *     It calls the function FBAD_COG(NCOG,IC),
575  *     accordingto the angle  *     accordingto the angle
576    *
577    *     >>> cosi` non e` corretto!!
578    *     >>> l'errore sulla coordinata eta si ottiene moltiplicando
579    *     >>> l'errore sulla coordinata cog per la derivata della
580    *     >>> distribuzione eta... pur sapendolo l'ho sempre ignorato...
581    *     >>> deve essere modificato!!!!
582    *
583  *-------------------------------------------------------  *-------------------------------------------------------
584    
585        include 'commontracker.f'        include 'commontracker.f'
# Line 588  c      if(mod(int(VIEW(ic)),2).eq.1)then Line 617  c      if(mod(int(VIEW(ic)),2).eq.1)then
617        end        end
618    
619  *** * * * *** * * * *** * * * *** * * * *** * * * *** * * * ***  *** * * * *** * * * *** * * * *** * * * *** * * * *** * * * ***
620        real function pfaeta2(ic,angle) !(1)        real function pfaeta2(ic,angle)
621  *--------------------------------------------------------------  *--------------------------------------------------------------
622  *     this function returns  *     this function returns
623  *  *
# Line 607  c      if(mod(int(VIEW(ic)),2).eq.1)then Line 636  c      if(mod(int(VIEW(ic)),2).eq.1)then
636        real cog2,angle        real cog2,angle
637        integer iview,lad        integer iview,lad
638    
639        iview = VIEW(ic)                    iview   = VIEW(ic)            
640        lad = nld(MAXS(ic),VIEW(ic))        lad     = nld(MAXS(ic),VIEW(ic))
641        cog2 = cog(2,ic)                  cog2    = cog(2,ic)          
642        pfaeta2=cog2        pfaeta2 = cog2
643    
644    *     ----------------
645  *     find angular bin  *     find angular bin
646    *     ----------------
647  *     (in futuro possiamo pensare di interpolare anche sull'angolo)  *     (in futuro possiamo pensare di interpolare anche sull'angolo)
648        do iang=1,nangbin        do iang=1,nangbin
649           if(angL(iang).lt.angle.and.angR(iang).ge.angle)then           if(angL(iang).lt.angle.and.angR(iang).ge.angle)then
# Line 626  c      if(mod(int(VIEW(ic)),2).eq.1)then Line 657  c      if(mod(int(VIEW(ic)),2).eq.1)then
657        if(angle.ge.angR(nangbin))iang=nangbin        if(angle.ge.angR(nangbin))iang=nangbin
658   98   continue                  !jump here if ok   98   continue                  !jump here if ok
659    
660    *     -------------
661    *     within +/-0.5
662    *     -------------
663    
664  c$$$*     find extremes of interpolation        iaddmax=10
 c$$$      iflag=0  
 c$$$*     --------------------------------  
 c$$$      if(cog2.lt.eta2(1,iang).or.cog2.gt.eta2(netaval,iang))then  
 c$$$c         print*,'pfaeta2 *** warning *** argument out of range: ',cog2  
 c$$$*         goto 100  
 c$$$*     ----------------------------------------------  
 c$$$*     non salto piu`, ma scalo di 1 o -1  
 c$$$*     nel caso si tratti di un cluster  
 c$$$*     in cui la strip con il segnale massimo non coincide  
 c$$$*     con la strip con il rapposto s/n massimo!!!  
 c$$$*     ----------------------------------------------  
 c$$$         if(cog2.lt.eta2(1,iang))then !temp  
 c$$$            cog2=cog2+1.        !temp  
 c$$$            iflag=1             !temp  
 c$$$         else                   !temp  
 c$$$            cog2=cog2-1.        !temp  
 c$$$            iflag=-1            !temp  
 c$$$         endif                  !temp  
 c$$$c         print*,'shifted >>> ',cog2  
 c$$$      endif  
   
665        iadd=0        iadd=0
666   10   continue   10   continue
667        if(cog2.lt.eta2(1,iang))then        if(cog2.lt.eta2(1,iang))then
668           cog2 = cog2 + 1           cog2 = cog2 + 1
669           iadd = iadd + 1           iadd = iadd + 1
670             if(iadd>iaddmax)goto 111
671           goto 10           goto 10
672        endif        endif
673   20   continue   20   continue
674        if(cog2.gt.eta2(netaval,iang))then        if(cog2.gt.eta2(netaval,iang))then
675           cog2 = cog2 - 1           cog2 = cog2 - 1
676           iadd = iadd - 1           iadd = iadd - 1
677             if(iadd<-1*iaddmax)goto 111
678           goto 20           goto 20
679        endif        endif
680          goto 1111
681     111  continue
682          if(DEBUG.eq.1)print*,'pfaeta2 *** warning *** anomalous cluster'
683          if(DEBUG.eq.1)print*,'--> COG(2) = ',cog2-iadd,' (set to zero)'
684          cog2=0
685     1111 continue
686    
687  *     --------------------------------  *     --------------------------------
688  c      print*,'*****',i,view,lad,iang,'------> cog2 ',cog2  c      print*,'*****',i,view,lad,iang,'------> cog2 ',cog2
# Line 700  c$$$      endif Line 721  c$$$      endif
721       $     ,cog2-iadd,' -->',pfaeta2       $     ,cog2-iadd,' -->',pfaeta2
722    
723    
724   100  return  c 100  return
725          return
726        end        end
727    
728  *** * * * *** * * * *** * * * *** * * * *** * * * *** * * * ***  *** * * * *** * * * *** * * * *** * * * *** * * * *** * * * ***
# Line 726  c$$$      endif Line 748  c$$$      endif
748    
749        iview = VIEW(ic)                    iview = VIEW(ic)            
750        lad = nld(MAXS(ic),VIEW(ic))        lad = nld(MAXS(ic),VIEW(ic))
751        cog3 = cog(3,ic)                    cog3 = cog(3,ic)
752          cc = cog3
753          cog3 = cc
754        pfaeta3=cog3        pfaeta3=cog3
755    
756    *     ----------------
757  *     find angular bin  *     find angular bin
758    *     ----------------
759  *     (in futuro possiamo pensare di interpolare anche sull'angolo)  *     (in futuro possiamo pensare di interpolare anche sull'angolo)
760        do iang=1,nangbin        do iang=1,nangbin
761  c         print*,'~~~~~~~~~~~~ ',iang,angL(iang),angR(iang),angle  c         print*,'~~~~~~~~~~~~ ',iang,angL(iang),angR(iang),angle
# Line 744  c         print*,'~~~~~~~~~~~~ ',iang,an Line 770  c         print*,'~~~~~~~~~~~~ ',iang,an
770        if(angle.ge.angR(nangbin))iang=nangbin        if(angle.ge.angR(nangbin))iang=nangbin
771   98   continue                  !jump here if ok   98   continue                  !jump here if ok
772    
773    *     -------------
774    *     within +/-0.5
775    *     -------------
776    
777  c$$$*     find extremes of interpolation        iaddmax=10
 c$$$      iflag=0  
 c$$$*     --------------------------------  
 c$$$      if(cog3.lt.eta3(1,iang).or.cog3.gt.eta3(netaval,iang))then  
 c$$$*     ----------------------------------------------  
 c$$$*     non salto piu`, ma scalo di 1 o -1  
 c$$$*     nel caso si tratti di un cluster  
 c$$$*     in cui la strip con il segnale massimo non coincide  
 c$$$*     con la strip con il rapposto s/n massimo!!!  
 c$$$*     ----------------------------------------------  
 c$$$         if(cog2.lt.eta2(1,iang))then !temp  
 c$$$            cog2=cog2+1.        !temp  
 c$$$            iflag=1             !temp  
 c$$$         else                   !temp  
 c$$$            cog2=cog2-1.        !temp  
 c$$$            iflag=-1            !temp  
 c$$$         endif                  !temp  
 c$$$c         print*,'shifted >>> ',cog2  
 c$$$      endif  
   
         
778        iadd=0        iadd=0
779   10   continue   10   continue
780        if(cog3.lt.eta3(1,iang))then        if(cog3.lt.eta3(1,iang))then
781           cog3 = cog3 + 1           cog3   = cog3 + 1.
782           iadd = iadd + 1           iadd = iadd + 1
783             if(iadd>iaddmax) goto 111
784           goto 10           goto 10
785        endif        endif
786   20   continue   20   continue
787        if(cog3.gt.eta3(netaval,iang))then        if(cog3.gt.eta3(netaval,iang))then
788           cog3 = cog3 - 1           cog3 = cog3 - 1.
789           iadd = iadd - 1           iadd = iadd - 1
790             if(iadd<-1*iaddmax) goto 111
791           goto 20           goto 20
792        endif        endif
793          goto 1111
794     111  continue
795          if(DEBUG.eq.1)print*,'pfaeta3 *** warning *** anomalous cluster'
796          if(DEBUG.eq.1)print*,'--> COG(3) = ',cog3-iadd,' (set to zero)'
797          cog3=0      
798     1111 continue
799    
800  *     --------------------------------  *     --------------------------------
801  c      print*,'*****',i,view,lad,iang,'------> cog2 ',cog2  c      print*,'*****',i,view,lad,iang,'------> cog2 ',cog2
# Line 804  c            print*,'-----',x1,x2,y1,y2 Line 821  c            print*,'-----',x1,x2,y1,y2
821        pfaeta3 = AA*cog3+BB        pfaeta3 = AA*cog3+BB
822        pfaeta3 = pfaeta3 - iadd        pfaeta3 = pfaeta3 - iadd
823    
 c$$$      if(iflag.eq.1)then  
 c$$$         pfaeta2=pfaeta2-1.   !temp  
 c$$$         cog2=cog2-1.           !temp  
 c$$$      endif  
 c$$$      if(iflag.eq.-1)then  
 c$$$         pfaeta2=pfaeta2+1.   !temp  
 c$$$         cog2=cog2+1.           !temp  
 c$$$      endif  
824    
825        if(DEBUG.EQ.1)print*,'ETA3  (ic ',ic,' ang',angle,')'        if(DEBUG.EQ.1)print*,'ETA3  (ic ',ic,' ang',angle,')'
826       $     ,cog3-iadd,' -->',pfaeta3       $     ,cog3-iadd,' -->',pfaeta3
827    
828   100  return  c 100  return
829          return
830        end        end
831    
832  *** * * * *** * * * *** * * * *** * * * *** * * * *** * * * ***  *** * * * *** * * * *** * * * *** * * * *** * * * *** * * * ***
# Line 845  c$$$      endif Line 855  c$$$      endif
855        cog4=cog(4,ic)        cog4=cog(4,ic)
856        pfaeta4=cog4        pfaeta4=cog4
857    
858    *     ----------------
859  *     find angular bin  *     find angular bin
860    *     ----------------
861  *     (in futuro possiamo pensare di interpolare anche sull'angolo)  *     (in futuro possiamo pensare di interpolare anche sull'angolo)
862        do iang=1,nangbin        do iang=1,nangbin
863  c         print*,'~~~~~~~~~~~~ ',iang,angL(iang),angR(iang),angle  c         print*,'~~~~~~~~~~~~ ',iang,angL(iang),angR(iang),angle
# Line 860  c         print*,'~~~~~~~~~~~~ ',iang,an Line 872  c         print*,'~~~~~~~~~~~~ ',iang,an
872        if(angle.ge.angR(nangbin))iang=nangbin        if(angle.ge.angR(nangbin))iang=nangbin
873   98   continue                  !jump here if ok   98   continue                  !jump here if ok
874    
875    *     -------------
876    *     within +/-0.5
877    *     -------------
878    
879  c$$$*     find extremes of interpolation        iaddmax=10
 c$$$      iflag=0  
 c$$$*     --------------------------------  
 c$$$      if(cog3.lt.eta3(1,iang).or.cog3.gt.eta3(netaval,iang))then  
 c$$$*     ----------------------------------------------  
 c$$$*     non salto piu`, ma scalo di 1 o -1  
 c$$$*     nel caso si tratti di un cluster  
 c$$$*     in cui la strip con il segnale massimo non coincide  
 c$$$*     con la strip con il rapposto s/n massimo!!!  
 c$$$*     ----------------------------------------------  
 c$$$         if(cog2.lt.eta2(1,iang))then !temp  
 c$$$            cog2=cog2+1.        !temp  
 c$$$            iflag=1             !temp  
 c$$$         else                   !temp  
 c$$$            cog2=cog2-1.        !temp  
 c$$$            iflag=-1            !temp  
 c$$$         endif                  !temp  
 c$$$c         print*,'shifted >>> ',cog2  
 c$$$      endif  
   
         
880        iadd=0        iadd=0
881   10   continue   10   continue
882        if(cog4.lt.eta4(1,iang))then        if(cog4.lt.eta4(1,iang))then
883           cog4 = cog4 + 1           cog4 = cog4 + 1
884           iadd = iadd + 1           iadd = iadd + 1
885             if(iadd>iaddmax)goto 111
886           goto 10           goto 10
887        endif        endif
888   20   continue   20   continue
889        if(cog4.gt.eta4(netaval,iang))then        if(cog4.gt.eta4(netaval,iang))then
890           cog4 = cog4 - 1           cog4 = cog4 - 1
891           iadd = iadd - 1           iadd = iadd - 1
892             if(iadd<-1*iaddmax)goto 111
893           goto 20           goto 20
894        endif        endif
895          goto 1111
896     111  continue
897          if(DEBUG.eq.1)print*,'pfaeta4 *** warning *** anomalous cluster'
898          if(DEBUG.eq.1)print*,'--> COG(4) = ',cog4-iadd,' (set to zero)'
899          cog4=0
900     1111 continue
901    
902  *     --------------------------------  *     --------------------------------
903  c      print*,'*****',i,view,lad,iang,'------> cog2 ',cog2  c      print*,'*****',i,view,lad,iang,'------> cog2 ',cog2
# Line 932  c$$$      endif Line 935  c$$$      endif
935        if(DEBUG.EQ.1)print*,'ETA4  (ic ',ic,' ang',angle,')'        if(DEBUG.EQ.1)print*,'ETA4  (ic ',ic,' ang',angle,')'
936       $     ,cog4-iadd,' -->',pfaeta4       $     ,cog4-iadd,' -->',pfaeta4
937    
938   100  return  c 100  return
939          return
940        end        end
941    
942    
# Line 997  c$$$      endif Line 1001  c$$$      endif
1001                    
1002           COG = 0.           COG = 0.
1003                    
1004  c         print*,'## ',sl2,sl1,sc,sr1,sr2  c      print *,'## ',sl2,sl1,sc,sr1,sr2
1005    
1006  c     ==============================================================  c     ==============================================================
1007           if(ncog.eq.1)then           if(ncog.eq.1)then
1008              COG = 0.              COG = 0.
1009              if(sr1.gt.sc)cog=1.           if(sr1.gt.sc)cog=1.
1010              if(sl1.gt.sc.and.sl1.gt.sr1)cog=-1.           if(sl1.gt.sc.and.sl1.gt.sr1)cog=-1.
1011  c     ==============================================================  c     ==============================================================
1012           elseif(ncog.eq.2)then           elseif(ncog.eq.2)then
1013              COG = 0.              COG = 0.
1014              if(sl1.gt.sr1)then              if(sl1.gt.sr1)then
1015                 if((sl1+sc).ne.0)COG = -sl1/(sl1+sc)                         if((sl1+sc).ne.0)COG = -sl1/(sl1+sc)        
1016              elseif(sl1.lt.sr1)then              elseif(sl1.lt.sr1)then
1017                 if((sc+sr1).ne.0)COG = sr1/(sc+sr1)                                         if((sc+sr1).ne.0)COG = sr1/(sc+sr1)
1018              elseif( sl1.eq.sr1.and.sl1.ne.-9999.)then           elseif( sl1.eq.sr1.and.sl1.ne.-9999.)then
1019                 if( clsigma(indmax(ic)-1).lt.clsigma(indmax(ic)+1)                 if( clsigma(indmax(ic)-1).lt.clsigma(indmax(ic)+1)
1020       $              .and.(sl1+sc).ne.0 )cog = -sl1/(sl1+sc)       $              .and.(sl1+sc).ne.0 )cog = -sl1/(sl1+sc)
1021                 if( clsigma(indmax(ic)-1).gt.clsigma(indmax(ic)+1)                 if( clsigma(indmax(ic)-1).gt.clsigma(indmax(ic)+1)
1022       $              .and.(sc+sr1).ne.0 )cog = sr1/(sc+sr1)       $              .and.(sc+sr1).ne.0 )cog = sr1/(sc+sr1)
1023              endif           endif
1024  c            if(cog==0)print*,'Strange cluster (2) - @maxs ',MAXS(ic)  c            if(cog==0)print*,'Strange cluster (2) - @maxs ',MAXS(ic)
1025  c     $           ,' : ',sl2,sl1,sc,sr1,sr2  c     $           ,' : ',sl2,sl1,sc,sr1,sr2
1026  c     ==============================================================  c     ==============================================================
# Line 1138  c         print*,'-------' Line 1142  c         print*,'-------'
1142    
1143  c      print *,'## cog ',ncog,ic,cog,'/////////////'  c      print *,'## cog ',ncog,ic,cog,'/////////////'
1144    
1145          if(COG.lt.-0.75.or.COG.gt.+0.75)then
1146             if(DEBUG.eq.1)
1147         $        print*,'cog *** warning *** anomalous cluster ??? --> '
1148             if(DEBUG.eq.1)
1149         $        print*,sl2,sl1,sc,sr1,sr2,' --> COG(',ncog,') = ',COG
1150          endif
1151    
1152    
1153        return        return
1154        end        end
1155    
# Line 1330  c            COG = 0. Line 1342  c            COG = 0.
1342        end        end
1343    
1344    
1345  c$$$*** * * * *** * * * *** * * * *** * * * *** * * * *** * * * ***  *** * * * *** * * * *** * * * *** * * * *** * * * *** * * * ***
1346  c$$$      real function fbad_cog0(ncog,ic)  
1347  c$$$*-------------------------------------------------------        real function riscogtheor(ncog,ic)
1348  c$$$*     this function returns a factor that takes into  *-------------------------------------------------------
1349  c$$$*     account deterioration of the spatial resolution  *
1350  c$$$*     in the case BAD strips are included in the cluster.  *     this function returns the expected resolution
1351  c$$$*     This factor should multiply the nominal spatial  *     obtained by propagating the strip noise
1352  c$$$*     resolution.  *     to the center-of-gravity coordinate
1353  c$$$*  *
1354  c$$$*     NB!!!  *     ncog = n.strip used in the coordinate evaluation
1355  c$$$*     (this is the old version. It consider only the two  *     (ncog=0 => all strips above threshold)
1356  c$$$*     strips with the greatest signal. The new one is  *
1357  c$$$*     fbad_cog(ncog,ic) )  *-------------------------------------------------------
1358  c$$$*      
1359  c$$$*-------------------------------------------------------        include 'commontracker.f'
1360  c$$$        include 'level1.f'
1361  c$$$      include 'commontracker.f'        include 'calib.f'
1362  c$$$      include 'level1.f'  
1363  c$$$      include 'calib.f'        if(mod(int(VIEW(ic)),2).eq.1)then !Y-view
1364  c$$$           incut = incuty
1365  c$$$*     --> signal of the central strip           pitch = pitchY / 1.e4
1366  c$$$      sc = CLSIGNAL(INDMAX(ic)) !center        else                      !X-view
1367  c$$$           incut = incutx
1368  c$$$*     signal of adjacent strips           pitch = pitchX / 1.e4
1369  c$$$*     --> left        endif
1370  c$$$      sl1 = 0                  !left 1        
1371  c$$$      if(        func = 100000.
1372  c$$$     $     (INDMAX(ic)-1).ge.INDSTART(ic)        stot = 0.
1373  c$$$     $     )  
1374  c$$$     $     sl1 = max(0.,CLSIGNAL(INDMAX(ic)-1))        if (ncog.gt.0) then
1375  c$$$  
1376  c$$$      sl2 = 0                  !left 2  *     --> signal of the central strip
1377  c$$$      if(           sc = CLSIGNAL(INDMAX(ic)) !center
1378  c$$$     $     (INDMAX(ic)-2).ge.INDSTART(ic)           fsc = clsigma(INDMAX(ic))
1379  c$$$     $     )  *     --> signal of adjacent strips
1380  c$$$     $     sl2 = max(0.,CLSIGNAL(INDMAX(ic)-2))           sl1 = 0                !left 1
1381  c$$$           fsl1 = 1               !left 1
1382  c$$$*     --> right           if(
1383  c$$$      sr1 = 0                  !right 1       $        (INDMAX(ic)-1).ge.INDSTART(ic)
1384  c$$$      if(       $        )then
1385  c$$$     $     (ic.ne.NCLSTR1.and.(INDMAX(ic)+1).lt.INDSTART(ic+1))              sl1 = CLSIGNAL(INDMAX(ic)-1)
1386  c$$$     $     .or.              fsl1 = clsigma(INDMAX(ic)-1)
1387  c$$$     $     (ic.eq.NCLSTR1.and.(INDMAX(ic)+1).le.TOTCLLENGTH)           endif
1388  c$$$     $     )  
1389  c$$$     $     sr1 = max(0.,CLSIGNAL(INDMAX(ic)+1))           sl2 = 0                !left 2
1390  c$$$           fsl2 = 1               !left 2
1391  c$$$      sr2 = 0                  !right 2           if(
1392  c$$$      if(       $        (INDMAX(ic)-2).ge.INDSTART(ic)
1393  c$$$     $     (ic.ne.NCLSTR1.and.(INDMAX(ic)+2).lt.INDSTART(ic+1))       $        )then
1394  c$$$     $     .or.              sl2 = CLSIGNAL(INDMAX(ic)-2)
1395  c$$$     $     (ic.eq.NCLSTR1.and.(INDMAX(ic)+2).le.TOTCLLENGTH)              fsl2 = clsigma(INDMAX(ic)-2)
1396  c$$$     $     )           endif
1397  c$$$     $     sr2 = max(0.,CLSIGNAL(INDMAX(ic)+2))           sr1 = 0                !right 1
1398  c$$$           fsr1 = 1               !right 1
1399  c$$$           if(
1400  c$$$      if(mod(int(VIEW(ic)),2).eq.1)then !Y-view       $        (ic.ne.NCLSTR1.and.(INDMAX(ic)+1).lt.INDSTART(ic+1))
1401  c$$$         f  = 4.       $        .or.
1402  c$$$         si = 8.4       $        (ic.eq.NCLSTR1.and.(INDMAX(ic)+1).le.TOTCLLENGTH)
1403  c$$$      else                              !X-view       $        )then
1404  c$$$         f  = 6.              sr1 = CLSIGNAL(INDMAX(ic)+1)
1405  c$$$         si = 3.9              fsr1 = clsigma(INDMAX(ic)+1)
1406  c$$$      endif           endif    
1407  c$$$           sr2 = 0                !right 2
1408  c$$$      fbad_cog = 1.           fsr2 = 1               !right 2
1409  c$$$      f0 = 1           if(
1410  c$$$      f1 = 1       $        (ic.ne.NCLSTR1.and.(INDMAX(ic)+2).lt.INDSTART(ic+1))
1411  c$$$      f2 = 1       $        .or.
1412  c$$$      f3 = 1         $        (ic.eq.NCLSTR1.and.(INDMAX(ic)+2).le.TOTCLLENGTH)
1413  c$$$      if(sl1.gt.sr1.and.sl1.gt.0.)then       $        )then
1414  c$$$                      sr2 = CLSIGNAL(INDMAX(ic)+2)
1415  c$$$         if(BAD(VIEW(ic),nvk(MAXS(ic)),nst(MAXS(ic))  ).eq.0)f0=f              fsr2 = clsigma(INDMAX(ic)+2)
1416  c$$$         if(BAD(VIEW(ic),nvk(MAXS(ic)),nst(MAXS(ic)-1)).eq.0)f1=f           endif
1417  c$$$c         if(BAD(VIEW(ic),nvk(MAXS(ic)),nst(MAXS(ic)+1)).eq.0)f3=f  
1418  c$$$  
1419  c$$$         if(ncog.eq.2.and.sl1.ne.0)then  
1420  c$$$            fbad_cog = (f1**2*sc**2/sl1**2+f0**2)/(sc**2/sl1**2+1.)  ************************************************************
1421  c$$$         elseif(ncog.eq.3.and.sl1.ne.0.and.sr1.ne.0)then  *     COG2-3-4 computation
1422  c$$$            fbad_cog = 1.  ************************************************************
1423  c$$$         elseif(ncog.eq.4.and.sl1.ne.0.and.sr1.ne.0.and.sl2.ne.0)then  
1424  c$$$            fbad_cog = 1.  c      print*,sl2,sl1,sc,sr1,sr2
1425  c$$$         else          
1426  c$$$            fbad_cog = 1.           vCOG = cog(ncog,ic)!0.
1427  c$$$         endif          
1428  c$$$                   if(ncog.eq.1)then
1429  c$$$      elseif(sl1.le.sr1.and.sr1.gt.0.)then              func = 1./12.
1430  c$$$              stot = 1.
1431  c$$$           elseif(ncog.eq.2)then
1432  c$$$         if(BAD(VIEW(ic),nvk(MAXS(ic)),nst(MAXS(ic))  ).eq.0)f0=f              if(sl1.gt.sr1)then
1433  c$$$         if(BAD(VIEW(ic),nvk(MAXS(ic)),nst(MAXS(ic)+1)).eq.0)f1=f                 func = (fsl1*(-1-vCOG)**2+fsc*(-vCOG)**2)
1434  c$$$c         if(BAD(VIEW(ic),nvk(MAXS(ic)),nst(MAXS(ic)-1)).eq.0)f3=f                 stot = sl1+sc
1435  c$$$              elseif(sl1.le.sr1)then
1436  c$$$         if(ncog.eq.2.and.sr1.ne.0)then                 func = (fsc*(-vCOG)**2+fsr1*(1-vCOG)**2)
1437  c$$$            fbad_cog = (f1**2*sc**2/sr1**2+f0**2)/(sc**2/sr1**2+1.)                 stot = sc+sr1
1438  c$$$         elseif(ncog.eq.3.and.sr1.ne.0.and.sl1.ne.0)then              endif
1439  c$$$            fbad_cog = 1.           elseif(ncog.eq.3)then
1440  c$$$         elseif(ncog.eq.4.and.sr1.ne.0.and.sl1.ne.0.and.sr2.ne.0)then              func =
1441  c$$$            fbad_cog = 1.       $           (fsl1*(-1-vCOG)**2+fsc*(-vCOG)**2+fsr1*(1-vCOG)**2)
1442  c$$$         else              stot = sl1+sc+sr1
1443  c$$$            fbad_cog = 1.           elseif(ncog.eq.4)then
1444  c$$$         endif              if(sl2.gt.sr2)then
1445  c$$$                 func =
1446  c$$$      endif       $              (fsl2*(-2-vCOG)**2+fsl1*(-1-vCOG)**2
1447  c$$$       $              +fsc*(-vCOG)**2+fsr1*(1-vCOG)**2)
1448  c$$$      fbad_cog0 = sqrt(fbad_cog)                 stot = sl2+sl1+sc+sr1
1449  c$$$              elseif(sl2.le.sr2)then
1450  c$$$      return                 func =
1451  c$$$      end       $              (fsl1*(-1-vCOG)**2
1452  c$$$       $              +fsc*(-vCOG)**2+fsr1*(1-vCOG)**2+fsr2*(2-vCOG)**2)
1453  c$$$                 stot = sl2+sl1+sc+sr1
1454  c$$$              endif
1455             else
1456                print*,'function riscogtheor(NCOG,IC) ==> NCOG=',NCOG
1457         $            ,' not implemented'
1458             endif
1459            
1460          elseif(ncog.eq.0)then
1461    *     =========================
1462    *     COG computation
1463    *     =========================
1464            
1465             vCOG = cog(0,ic)
1466    
1467             iv     = VIEW(ic)
1468             istart = INDSTART(IC)
1469             istop  = TOTCLLENGTH
1470             if(ic.lt.NCLSTR1)istop = INDSTART(IC+1)-1
1471    ccc         SGN = 0.
1472             SNU = 0.
1473    ccc         SDE = 0.
1474    
1475             do i=INDMAX(IC),istart,-1
1476                ipos = i-INDMAX(ic)
1477                cut  = incut*CLSIGMA(i)
1478                if(CLSIGNAL(i).gt.cut)then
1479                   fs = clsigma(i)
1480                   SNU  = SNU + fs*(ipos-vCOG)**2
1481                   stot = stot + CLSIGNAL(i)
1482                else
1483                   goto 10
1484                endif            
1485             enddo
1486     10      continue
1487             do i=INDMAX(IC)+1,istop
1488                ipos = i-INDMAX(ic)
1489                cut  = incut*CLSIGMA(i)
1490                if(CLSIGNAL(i).gt.cut)then
1491                   fs = clsigma(i)
1492                   SNU  = SNU + fs*(ipos-vCOG)**2
1493                   stot = stot + CLSIGNAL(i)
1494                else
1495                   goto 20
1496                endif            
1497             enddo
1498     20      continue
1499             if(SDE.ne.0)then
1500                FUNC=SNU
1501             else
1502                
1503             endif
1504    
1505          else
1506                      
1507             FUNC=0
1508             print*,'function FUNC(NCOG,IC) ==> WARNING!! NCOG=',NCOG
1509             print*,'                               (NCOG must be >= 0)'
1510            
1511    
1512          endif
1513    
1514    
1515          if(stot.gt.0..and.func.gt.0.)then
1516             func = sqrt(func)
1517             func = pitch * func/stot
1518          endif
1519    
1520          riscogtheor = func
1521    
1522          return
1523          end
1524    
1525    
1526    
1527    *** * * * *** * * * *** * * * *** * * * *** * * * *** * * * ***
1528    
1529          real function risetatheor(ncog,ic,angle)
1530    *-------------------------------------------------------
1531    *
1532    *     this function returns the expected resolution
1533    *     obtained by propagating the strip noise
1534    *     to the coordinate evaluated with non-linear eta-function
1535    *
1536    *     ncog = n.strip used in the coordinate evaluation
1537    *     (ncog=0 => ncog=2,3,4 according to angle)
1538    *
1539    *-------------------------------------------------------
1540    
1541          include 'commontracker.f'
1542          include 'level1.f'
1543          include 'calib.f'
1544    
1545    
1546          func = 1.
1547    
1548          iview   = VIEW(ic)            
1549          lad     = nld(MAXS(ic),VIEW(ic))
1550    
1551    *     ------------------------------------------------
1552    *     number of strip to be used (in case of ncog = 0)
1553    *     ------------------------------------------------
1554    
1555          inoeta = 0
1556    
1557          if(mod(int(iview),2).eq.1)then !Y-view
1558    
1559             pitch = pitchY / 1.e4
1560    
1561             if(ncog.eq.0)then
1562                if( abs(angle).ge.e2fay.and.abs(angle).le.e2tay )then
1563                   ncog = 2
1564                elseif( abs(angle).ge.e3fay.and.abs(angle).le.e3tay )then
1565                   ncog = 3
1566                elseif( abs(angle).ge.e4fay.and.abs(angle).le.e4tay )then
1567                   ncog = 4
1568                else
1569                   ncog   = 4
1570                   inoeta = 1
1571                endif            
1572             endif
1573    
1574          else                      !X-view
1575    
1576             pitch = pitchX / 1.e4
1577    
1578             if(ncog.eq.0)then
1579                if( abs(angle).ge.e2fax.and.abs(angle).le.e2tax )then
1580                   ncog = 2
1581                elseif( abs(angle).ge.e3fax.and.abs(angle).le.e3tax )then
1582                   ncog = 3
1583                elseif( abs(angle).ge.e4fax.and.abs(angle).le.e4tax )then
1584                   ncog = 4
1585                else
1586                   ncog = 4
1587                   inoeta = 1
1588                endif            
1589             endif
1590    
1591          endif
1592          
1593          func = riscogtheor(ncog,ic)
1594    
1595          risetatheor = func
1596          
1597          if(inoeta.eq.1)return ! no eta correction is applied --> exit
1598          if(ncog.lt.1.or.ncog.gt.4)return
1599    
1600    *     ----------------
1601    *     find angular bin
1602    *     ----------------
1603    *     (in futuro possiamo pensare di interpolare anche sull'angolo)
1604          do iang=1,nangbin
1605             if(angL(iang).lt.angle.and.angR(iang).ge.angle)then
1606                iangle=iang
1607                goto 98
1608             endif
1609          enddo
1610          if(DEBUG.EQ.1)print*
1611         $     ,'risetatheor *** warning *** angle out of range: ',angle
1612          if(angle.le.angL(1))iang=1
1613          if(angle.ge.angR(nangbin))iang=nangbin
1614     98   continue                  !jump here if ok
1615    
1616    *     -------------
1617    *     within +/-0.5
1618    *     -------------
1619    
1620          vcog = cog(ncog,ic)          
1621    
1622          etamin = eta2(1,iang)
1623          etamax = eta2(netaval,iang)
1624    
1625          iaddmax=10
1626          iadd=0
1627     10   continue
1628          if(vcog.lt.etamin)then
1629             vcog = vcog + 1
1630             iadd = iadd + 1
1631             if(iadd>iaddmax)goto 111
1632             goto 10
1633          endif
1634     20   continue
1635          if(vcog.gt.etamax)then
1636             vcog = vcog - 1
1637             iadd = iadd - 1
1638             if(iadd<-1*iaddmax)goto 111
1639             goto 20
1640          endif
1641          goto 1111
1642     111  continue
1643          if(DEBUG.eq.1)
1644         $     print*,'risetatheor *** warning *** anomalous cluster'
1645          if(DEBUG.eq.1)
1646         $     print*,'--> COG(',ncog,') = ',vcog-iadd,' (set to zero)'
1647          vcog=0
1648     1111 continue
1649    
1650    *     ------------------------------------------------
1651    *     interpolation
1652    *     ------------------------------------------------
1653    
1654    
1655          ibin = netaval
1656          do i=2,netaval        
1657             if(ncog.eq.2)eta=eta2(i,iang)
1658             if(ncog.eq.3)eta=eta3(i,iang)
1659             if(ncog.eq.4)eta=eta4(i,iang)
1660             if(eta.ge.vcog)then
1661                ibin = i
1662                goto 99
1663             endif
1664          enddo
1665     99   continue
1666    
1667          if(ncog.eq.2)then
1668             x1 = eta2(ibin-1,iang)
1669             x2 = eta2(ibin,iang)
1670             y1 = feta2(ibin-1,iview,lad,iang)
1671             y2 = feta2(ibin,iview,lad,iang)
1672          elseif(ncog.eq.3)then
1673             x1 = eta3(ibin-1,iang)
1674             x2 = eta3(ibin,iang)
1675             y1 = feta3(ibin-1,iview,lad,iang)
1676             y2 = feta3(ibin,iview,lad,iang)
1677          elseif(ncog.eq.4)then
1678             x1 = eta4(ibin-1,iang)
1679             x2 = eta4(ibin,iang)
1680             y1 = feta4(ibin-1,iview,lad,iang)
1681             y2 = feta4(ibin,iview,lad,iang)
1682          endif
1683          
1684          func = func * (y2-y1)/(x2-x1)
1685    
1686          risetatheor = func
1687    
1688          return
1689          end
1690    
1691  *** * * * *** * * * *** * * * *** * * * *** * * * *** * * * ***  *** * * * *** * * * *** * * * *** * * * *** * * * *** * * * ***
1692    
# Line 1967  c$$$ Line 2214  c$$$
2214    
2215        pfacorr = fcorr(iview,lad,iang)        pfacorr = fcorr(iview,lad,iang)
2216    
2217        if(DEBUG.eq.1)print*,'CORR  (ic ',ic,' ang',angle,') -->',pfacorr        if(DEBUG.eq.1)print*,'LANDI (ic ',ic,' ang',angle,') -->',pfacorr
2218    
2219          
2220   100  return  c 100  return
2221          return
2222        end        end
Legend:
Removed from v.1.22  
changed lines
  Added in v.1.26
  ViewVC Help
Powered by ViewVC 1.1.23