--- DarthVader/TrackerLevel2/src/F77/analysissubroutines.f 2007/05/09 07:50:58 1.22 +++ DarthVader/TrackerLevel2/src/F77/analysissubroutines.f 2007/05/24 13:29:09 1.25 @@ -578,6 +578,9 @@ parameter (ndivx=30) + + +c$$$ print*,icx,icy,sensor,PFAx,PFAy,ax,ay,bfx,bfy resxPAM = 0 resyPAM = 0 @@ -664,7 +667,7 @@ elseif(PFAx.eq.'ETA2')then stripx = stripx + pfaeta2(icx,angx) - resxPAM = risx_eta2(abs(angx)) + resxPAM = risxeta2(abs(angx)) resxPAM = resxPAM*fbad_cog(2,icx) if(DEBUG.and.fbad_cog(2,icx).ne.1) $ print*,'BAD icx >>> ',viewx,fbad_cog(2,icx) @@ -672,7 +675,7 @@ elseif(PFAx.eq.'ETA3')then stripx = stripx + pfaeta3(icx,angx) - resxPAM = risx_eta3(abs(angx)) + resxPAM = risxeta3(abs(angx)) resxPAM = resxPAM*fbad_cog(3,icx) if(DEBUG.and.fbad_cog(3,icx).ne.1) $ print*,'BAD icx >>> ',viewx,fbad_cog(3,icx) @@ -680,7 +683,7 @@ elseif(PFAx.eq.'ETA4')then stripx = stripx + pfaeta4(icx,angx) - resxPAM = risx_eta4(abs(angx)) + resxPAM = risxeta4(abs(angx)) resxPAM = resxPAM*fbad_cog(4,icx) if(DEBUG.and.fbad_cog(4,icx).ne.1) $ print*,'BAD icx >>> ',viewx,fbad_cog(4,icx) @@ -688,7 +691,8 @@ elseif(PFAx.eq.'ETA')then stripx = stripx + pfaeta(icx,angx) - resxPAM = ris_eta(icx,angx) +c resxPAM = riseta(icx,angx) + resxPAM = riseta(viewx,angx) resxPAM = resxPAM*fbad_eta(icx,angx) if(DEBUG.and.fbad_cog(2,icx).ne.1) $ print*,'BAD icx >>> ',viewx,fbad_cog(2,icx) @@ -782,7 +786,7 @@ elseif(PFAy.eq.'ETA2')then stripy = stripy + pfaeta2(icy,angy) - resyPAM = risy_eta2(abs(angy)) + resyPAM = risyeta2(abs(angy)) resyPAM = resyPAM*fbad_cog(2,icy) if(DEBUG.and.fbad_cog(2,icy).ne.1) $ print*,'BAD icy >>> ',viewy,fbad_cog(2,icy) @@ -804,7 +808,8 @@ elseif(PFAy.eq.'ETA')then stripy = stripy + pfaeta(icy,angy) - resyPAM = ris_eta(icy,angy) +c resyPAM = riseta(icy,angy) + resyPAM = riseta(viewy,angy) resyPAM = resyPAM*fbad_eta(icy,angy) if(DEBUG.and.fbad_cog(2,icy).ne.1) $ print*,'BAD icy >>> ',viewy,fbad_cog(2,icy) @@ -834,7 +839,7 @@ endif -c print*,'## stripx,stripy ',stripx,stripy +c$$$ print*,'## stripx,stripy ',stripx,stripy c=========================================================== C COUPLE @@ -1050,6 +1055,144 @@ 100 continue end +************************************************************************ +* Call xyz_PAM subroutine with default PFA and fill the mini2 common. +* (done to be called from c/c++) +************************************************************************ + + subroutine xyzpam(ip,icx,icy,lad,sensor,ax,ay,bfx,bfy) + + include 'commontracker.f' + include 'level1.f' + include 'common_mini_2.f' + include 'common_xyzPAM.f' + include 'common_mech.f' + include 'calib.f' + +* flag to chose PFA +c$$$ character*10 PFA +c$$$ common/FINALPFA/PFA + + integer icx,icy !X-Y cluster ID + integer sensor + character*4 PFAx,PFAy !PFA to be used + real ax,ay !X-Y geometric angle + real bfx,bfy !X-Y b-field components + + ipx=0 + ipy=0 + +c$$$ PFAx = 'COG4'!PFA +c$$$ PFAy = 'COG4'!PFA + + call idtoc(pfaid,PFAx) + call idtoc(pfaid,PFAy) + + call xyz_PAM(icx,icy,sensor,PFAx,PFAy,ax,ay,bfx,bfy) + +c$$$ print*,icx,icy,sensor,PFAx,PFAy,ax,ay,bfx,bfy + + if(icx.ne.0.and.icy.ne.0)then + + ipx=npl(VIEW(icx)) + ipy=npl(VIEW(icy)) + if( (nplanes-ipx+1).ne.ip.or.(nplanes-ipy+1).ne.ip ) + $ print*,'xyzpam: ***WARNING*** clusters ',icx,icy + $ ,' does not belong to the correct plane: ',ip,ipx,ipy + + xgood(ip) = 1. + ygood(ip) = 1. + resx(ip) = resxPAM + resy(ip) = resyPAM + + xm(ip) = xPAM + ym(ip) = yPAM + zm(ip) = zPAM + xm_A(ip) = 0. + ym_A(ip) = 0. + xm_B(ip) = 0. + ym_B(ip) = 0. + +c zv(ip) = zPAM + + elseif(icx.eq.0.and.icy.ne.0)then + + ipy=npl(VIEW(icy)) + if((nplanes-ipy+1).ne.ip) + $ print*,'xyzpam: ***WARNING*** clusters ',icx,icy + $ ,' does not belong to the correct plane: ',ip,ipx,ipy + + xgood(ip) = 0. + ygood(ip) = 1. + resx(ip) = 1000. + resy(ip) = resyPAM + + xm(ip) = -100. + ym(ip) = -100. + zm(ip) = (zPAM_A+zPAM_B)/2. + xm_A(ip) = xPAM_A + ym_A(ip) = yPAM_A + xm_B(ip) = xPAM_B + ym_B(ip) = yPAM_B + +c zv(ip) = (zPAM_A+zPAM_B)/2. + + elseif(icx.ne.0.and.icy.eq.0)then + + ipx=npl(VIEW(icx)) + if((nplanes-ipx+1).ne.ip) + $ print*,'xyzpam: ***WARNING*** clusters ',icx,icy + $ ,' does not belong to the correct plane: ',ip,ipx,ipy + + xgood(ip) = 1. + ygood(ip) = 0. + resx(ip) = resxPAM + resy(ip) = 1000. + + xm(ip) = -100. + ym(ip) = -100. + zm(ip) = (zPAM_A+zPAM_B)/2. + xm_A(ip) = xPAM_A + ym_A(ip) = yPAM_A + xm_B(ip) = xPAM_B + ym_B(ip) = yPAM_B + +c zv(ip) = (zPAM_A+zPAM_B)/2. + + else + + il = 2 + if(lad.ne.0)il=lad + is = 1 + if(sensor.ne.0)is=sensor +c print*,nplanes-ip+1,il,is + + xgood(ip) = 0. + ygood(ip) = 0. + resx(ip) = 1000. + resy(ip) = 1000. + + xm(ip) = -100. + ym(ip) = -100. + zm(ip) = z_mech_sensor(nplanes-ip+1,il,is)*1000./1.d4 + xm_A(ip) = 0. + ym_A(ip) = 0. + xm_B(ip) = 0. + ym_B(ip) = 0. + +c zv(ip) = z_mech_sensor(nplanes-ip+1,il,is)*1000./1.d4 + + endif + + if(DEBUG)then +c print*,'----------------------------- track coord' +22222 format(i2,' * ',3f10.4,' --- ',4f10.4,' --- ',2f4.0,2f10.5) + write(*,22222)ip,zm(ip),xm(ip),ym(ip) + $ ,xm_A(ip),ym_A(ip),xm_B(ip),ym_B(ip) + $ ,xgood(ip),ygood(ip),resx(ip),resy(ip) +c$$$ print*,'-----------------------------' + endif + end ******************************************************************************** ********************************************************************************