/[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.14 by pam-fi, Tue Aug 7 13:56:29 2007 UTC revision 1.18 by pam-fi, Mon Aug 20 16:07:16 2007 UTC
# Line 3  Line 3 
3        subroutine idtoc(ipfa,cpfa)        subroutine idtoc(ipfa,cpfa)
4                
5        integer ipfa        integer ipfa
6        character*4 cpfa        character*10 cpfa
7    
8        CPFA='COG4'        CPFA='COG4'
9        if(ipfa.eq.0)CPFA='ETA'        if(ipfa.eq.0)CPFA='ETA'
10        if(ipfa.eq.2)CPFA='ETA2'        if(ipfa.eq.2)CPFA='ETA2'
11        if(ipfa.eq.3)CPFA='ETA3'        if(ipfa.eq.3)CPFA='ETA3'
12        if(ipfa.eq.4)CPFA='ETA4'        if(ipfa.eq.4)CPFA='ETA4'
13          if(ipfa.eq.5)CPFA='ETAL'
14        if(ipfa.eq.10)CPFA='COG'        if(ipfa.eq.10)CPFA='COG'
15        if(ipfa.eq.11)CPFA='COG1'        if(ipfa.eq.11)CPFA='COG1'
16        if(ipfa.eq.12)CPFA='COG2'        if(ipfa.eq.12)CPFA='COG2'
# Line 164  c      print*,pfastrips Line 165  c      print*,pfastrips
165        end        end
166    
167  *** * * * *** * * * *** * * * *** * * * *** * * * *** * * * ***  *** * * * *** * * * *** * * * *** * * * *** * * * *** * * * ***
168          real function pfaetal(ic,angle)
169    *--------------------------------------------------------------
170    *     this function returns the position (in strip units)
171    *     it calls:
172    *     - pfaeta2(ic,angle)+pfcorr(ic,angle)
173    *     - pfaeta3(ic,angle)+pfcorr(ic,angle)
174    *     - pfaeta4(ic,angle)+pfcorr(ic,angle)
175    *     according to the angle
176    *--------------------------------------------------------------
177          include 'commontracker.f'
178          include 'level1.f'
179          include 'calib.f'
180          
181          pfaeta = 0
182    
183          if(mod(int(VIEW(ic)),2).eq.1)then !Y-view
184          
185             if( abs(angle).ge.e2fay.and.abs(angle).le.e2tay )then
186                pfaeta = pfaeta2(ic,angle)+pfacorr(ic,angle)
187             elseif( abs(angle).ge.e3fay.and.abs(angle).le.e3tay )then
188                pfaeta = pfaeta3(ic,angle)+pfacorr(ic,angle)
189             elseif( abs(angle).ge.e4fay.and.abs(angle).le.e4tay )then
190                pfaeta = pfaeta4(ic,angle)+pfacorr(ic,angle)
191             else
192                pfaeta = cog(4,ic)
193             endif            
194    
195          else                      !X-view
196    
197             if( abs(angle).ge.e2fax.and.abs(angle).le.e2tax )then
198                pfaeta = pfaeta2(ic,angle)+pfacorr(ic,angle)
199             elseif( abs(angle).ge.e3fax.and.abs(angle).le.e3tax )then
200                pfaeta = pfaeta3(ic,angle)+pfacorr(ic,angle)
201             elseif( abs(angle).ge.e4fax.and.abs(angle).le.e4tax )then
202                pfaeta = pfaeta4(ic,angle)+pfacorr(ic,angle)
203             else
204                pfaeta = cog(4,ic)
205             endif            
206                
207          endif
208          
209     100  return
210          end
211    *** * * * *** * * * *** * * * *** * * * *** * * * *** * * * ***
212  c      real function riseta(ic,angle)  c      real function riseta(ic,angle)
213        real function riseta(iview,angle)        real function riseta(iview,angle)
214  *--------------------------------------------------------------  *--------------------------------------------------------------
# Line 210  c      if(mod(int(VIEW(ic)),2).eq.1)then Line 255  c      if(mod(int(VIEW(ic)),2).eq.1)then
255                            
256        endif        endif
257    
 cc      print*,'---- ',riseta,iview,angle  
258    
259   100  return   100  return
260        end        end
# Line 294  cc      print*,'---- ',riseta,iview,angl Line 338  cc      print*,'---- ',riseta,iview,angl
338              goto 98              goto 98
339           endif           endif
340        enddo        enddo
341        if(DEBUG)        if(DEBUG.EQ.1)
342       $     print*,'pfaeta2 *** warning *** angle out of range: ',angle       $     print*,'pfaeta2 *** warning *** angle out of range: ',angle
343        if(angle.lt.angL(1))iang=1        if(angle.lt.angL(1))iang=1
344        if(angle.gt.angR(nangbin))iang=nangbin        if(angle.gt.angR(nangbin))iang=nangbin
# Line 370  c$$$         pfaeta2=pfaeta2+1.   !temp Line 414  c$$$         pfaeta2=pfaeta2+1.   !temp
414  c$$$         cog2=cog2+1.           !temp  c$$$         cog2=cog2+1.           !temp
415  c$$$      endif  c$$$      endif
416    
417        if(DEBUG)print*,'ETA2  (ic ',ic,' ang',angle,')'        if(DEBUG.EQ.1)print*,'ETA2  (ic ',ic,' ang',angle,')'
418       $     ,cog2-iadd,' -->',pfaeta2       $     ,cog2-iadd,' -->',pfaeta2
419    
420    
# Line 412  c         print*,'~~~~~~~~~~~~ ',iang,an Line 456  c         print*,'~~~~~~~~~~~~ ',iang,an
456              goto 98              goto 98
457           endif           endif
458        enddo        enddo
459        if(DEBUG)        if(DEBUG.EQ.1)
460       $     print*,'pfaeta3 *** warning *** angle out of range: ',angle       $     print*,'pfaeta3 *** warning *** angle out of range: ',angle
461        if(angle.lt.angL(1))iang=1        if(angle.lt.angL(1))iang=1
462        if(angle.gt.angR(nangbin))iang=nangbin        if(angle.gt.angR(nangbin))iang=nangbin
# Line 487  c$$$         pfaeta2=pfaeta2+1.   !temp Line 531  c$$$         pfaeta2=pfaeta2+1.   !temp
531  c$$$         cog2=cog2+1.           !temp  c$$$         cog2=cog2+1.           !temp
532  c$$$      endif  c$$$      endif
533    
534        if(DEBUG)print*,'ETA3  (ic ',ic,' ang',angle,')'        if(DEBUG.EQ.1)print*,'ETA3  (ic ',ic,' ang',angle,')'
535       $     ,cog3-iadd,' -->',pfaeta3       $     ,cog3-iadd,' -->',pfaeta3
536    
537   100  return   100  return
# Line 528  c         print*,'~~~~~~~~~~~~ ',iang,an Line 572  c         print*,'~~~~~~~~~~~~ ',iang,an
572              goto 98              goto 98
573           endif           endif
574        enddo        enddo
575        if(DEBUG)        if(DEBUG.EQ.1)
576       $     print*,'pfaeta4 *** warning *** angle out of range: ',angle       $     print*,'pfaeta4 *** warning *** angle out of range: ',angle
577        if(angle.lt.angL(1))iang=1        if(angle.lt.angL(1))iang=1
578        if(angle.gt.angR(nangbin))iang=nangbin        if(angle.gt.angR(nangbin))iang=nangbin
# Line 603  c$$$         pfaeta2=pfaeta2+1.   !temp Line 647  c$$$         pfaeta2=pfaeta2+1.   !temp
647  c$$$         cog2=cog2+1.           !temp  c$$$         cog2=cog2+1.           !temp
648  c$$$      endif  c$$$      endif
649    
650        if(DEBUG)print*,'ETA4  (ic ',ic,' ang',angle,')'        if(DEBUG.EQ.1)print*,'ETA4  (ic ',ic,' ang',angle,')'
651       $     ,cog4-iadd,' -->',pfaeta4       $     ,cog4-iadd,' -->',pfaeta4
652    
653   100  return   100  return
# Line 787  c     ================================== Line 831  c     ==================================
831                 if( clsigma(indmax(ic)-1).gt.clsigma(indmax(ic)+1)                 if( clsigma(indmax(ic)-1).gt.clsigma(indmax(ic)+1)
832       $              .and.(sc+sr1).ne.0 )cog = sr1/(sc+sr1) !NEW       $              .and.(sc+sr1).ne.0 )cog = sr1/(sc+sr1) !NEW
833              endif              endif
834  c$$$            if(cog==0)print*,'Strange cluster (2) - @maxs ',MAXS(ic)  c            if(cog==0)print*,'Strange cluster (2) - @maxs ',MAXS(ic)
835  c$$$     $           ,VIEW(ic),LADDER(ic)  c     $           ,' : ',sl2,sl1,sc,sr1,sr2
 c$$$     $           ,' : ',sl2,sl1,sc,sr1,sr2  
836  c     ==============================================================  c     ==============================================================
837           elseif(ncog.eq.3)then           elseif(ncog.eq.3)then
838               if( (sl1+sc+sr1).ne.0 )COG = (sr1-sl1)/(sl1+sc+sr1)               if( (sl1+sc+sr1).ne.0 )COG = (sr1-sl1)/(sl1+sc+sr1)
839  c$$$             if(cog==0)print*,'Strange cluster (3) - @maxs ',MAXS(ic)  c             if(cog==0)print*,'Strange cluster (3) - @maxs ',MAXS(ic)
840  c$$$     $           ,VIEW(ic),LADDER(ic)  c     $            ,' : ',sl2,sl1,sc,sr1,sr2
 c$$$     $            ,' : ',sl2,sl1,sc,sr1,sr2  
841  c     ==============================================================  c     ==============================================================
842           elseif(ncog.eq.4)then           elseif(ncog.eq.4)then
843              if(sl2.gt.sr2)then              if(sl2.gt.sr2)then
# Line 812  c     ================================== Line 854  c     ==================================
854       $              .and.(sr2+sl1+sc+sr1).ne.0 )       $              .and.(sr2+sl1+sc+sr1).ne.0 )
855       $              cog = (2*sr2+sr1-sl1)/(sr2+sl1+sc+sr1)  !NEW                     $              cog = (2*sr2+sr1-sl1)/(sr2+sl1+sc+sr1)  !NEW              
856              endif              endif
 c$$$            if(cog==0)print*,'Strange cluster (4) - @maxs ',MAXS(ic)  
 c$$$     $           ,VIEW(ic),LADDER(ic)  
 c$$$     $           ,' : ',sl2,sl1,sc,sr1,sr2  
 c     ==============================================================  
857           else           else
858              print*,'function COG(NCOG,IC) ==> WARNING!! NCOG=',NCOG              print*,'function COG(NCOG,IC) ==> WARNING!! NCOG=',NCOG
859       $           ,' not implemented'       $           ,' not implemented'
# Line 1712  c         if(BAD(VIEW(ic),nvk(MAXS(ic)), Line 1750  c         if(BAD(VIEW(ic),nvk(MAXS(ic)),
1750        risx_cog = HQUADF * 1e-4        risx_cog = HQUADF * 1e-4
1751    
1752        END        END
1753    
1754    
1755    *** * * * *** * * * *** * * * *** * * * *** * * * *** * * * ***
1756          real function pfacorr(ic,angle) !(1)
1757    *--------------------------------------------------------------
1758    *     this function returns the landi correction for this cluster
1759    *--------------------------------------------------------------
1760          include 'commontracker.f'
1761          include 'calib.f'
1762          include 'level1.f'
1763    
1764          real angle
1765          integer iview,lad
1766    
1767          iview = VIEW(ic)            
1768          lad = nld(MAXS(ic),VIEW(ic))
1769    
1770    *     find angular bin
1771    *     (in futuro possiamo pensare di interpolare anche sull'angolo)
1772          do iang=1,nangbin
1773             if(angL(iang).lt.angle.and.angR(iang).ge.angle)then
1774                iangle=iang
1775                goto 98
1776             endif
1777          enddo
1778          if(DEBUG.eq.1)
1779         $     print*,'pfacorr *** warning *** angle out of range: ',angle
1780          if(angle.lt.angL(1))iang=1
1781          if(angle.gt.angR(nangbin))iang=nangbin
1782     98   continue                  !jump here if ok
1783    
1784          pfacorr = fcorr(iview,lad,iang)
1785    
1786          if(DEBUG.eq.1)print*,'CORR  (ic ',ic,' ang',angle,') -->',pfacorr
1787    
1788    
1789     100  return
1790          end
Legend:
Removed from v.1.14  
changed lines
  Added in v.1.18
  ViewVC Help
Powered by ViewVC 1.1.23