C ======================== SUBROUTINE DO_SIRA95(XV) C ======================== C C ------------------------------------------------------------- C --- Run SINISTRA95. --- C --- Select "best" candidate. --- C --- Fill electron candidate. --- C C 11/05/99 N.Tuning Count number of Sinistra candidates with C prob>0.9 and E>4GeV. C 12/12/99 B.Straub replace call to emEnergyCorrection with C call to siraEnergyCorrection, which is an C interface to a new version of emEnergyCorrection. C ------------------------------------------------------------- IMPLICIT NONE #include "empar.inc" #include "sidat95.inc" ! /* !!! SINISTRA95 COMMON */ #include "zescommon.inc" #include "zestmpcommon.inc" LOGICAL FIRST DATA FIRST / .TRUE. / INTEGER J,K REAL XV(3), CALPOS(3), SPOS(3),SRTDC(20), ECAL REAL ESRTD, ECORR_SRTD, RDIST, tmp_x, tmp_y, tmp_z REAL ECORR(nEeCorr), ECorrError, dCellGap, dModGap INTEGER IDCLU, ICAND, IERR, I, Ncones INTEGER CENTRAL_TILE REAL PSAME(3), Radius(1) REAL EInDummy(100), ENotInDummy(100) REAL Relec, EMCenrgy, HACenrgy REAL NOUSE DATA NOUSE / -999.99 / IF (FIRST) THEN FIRST = .FALSE. WRITE(*,*) ' *********** SINISTRA 95 ******** ' WRITE(*,*) ' CUT VALUE ---------- 0.6 ' WRITE(*,*) ' ******************************** ' DO I=1,20 SRTDC(I) = 0.0 ENDDO ENDIF ZES_Eeu_si = NOUSE ZES_Xeu_si = NOUSE ZES_Yeu_si = NOUSE ZES_Zeu_si = NOUSE ZES_Prob_si = NOUSE ZES_Trkmatch_si = NOUSE ZES_xsrtd_si = NOUSE ZES_ysrtd_si = NOUSE ZES_Esrtd_si = NOUSE ZES_Fsrtd_si = NOUSE ZES_Epres1_si = NOUSE ZES_Epres2_si = NOUSE ZES_Epres3_si = NOUSE ZES_xhes_si = NOUSE ZES_yhes_si = NOUSE ZES_rhes_si = NOUSE ZES_ehes_si = NOUSE ZES_Ein_si = NOUSE ZES_ENin_si = NOUSE ZES_ecorr_si = NOUSE ZES_theta_si = NOUSE ZES_phi_si = NOUSE ZES_pt_si = NOUSE ZES_NcandG_si = 0 ZESTMP_Ncell_si = 0 ZESTMP_Ncand_si = 0 C --- Init second electron --- ZES_2Eeu_si = NOUSE ZESTMP_2Xeu_si = NOUSE ZESTMP_2Yeu_si = NOUSE ZESTMP_2Zeu_si = NOUSE ZES_2Prob_si = NOUSE ZES_2Ein_si = NOUSE ZES_2theta_si = NOUSE ZESTMP_2phi_si = NOUSE ZES_2pt_si = NOUSE ZESTMP_2Ncell_si = 0 C --- need additional bug fix for PRESAMPLER here ... CALL PRCALIB(Ierr) C CALL SIRA95 (XV, 0.6, IERR) C IF (Ierr .NE. 0) RETURN ZESTMP_Ncand_si = Ncand CALL FINDIS95( 1, 0.6, Icand, Ierr) IF (ICand .GT. 0) THEN C --- Do tower to cell island splitting if --- C --- within 60cm of RCAL beam pipe --- IF ((CANDAT(5,Icand) .LT. -140.0) .AND. & (CANDAT(3,Icand)**2 + CANDAT(4,Icand)**2) .LT.3600.0) THEN CALL Tow_to_cIsland(XV,Icand, Ierr) ENDIF C ----------------------------------------- C --- Count number of Good Candidates --- C ----------------------------------------- ZES_NcandG_si = 0 Do I = 1, Ncand If ( CANDAT(1,I) .GT. 0.9 .and. ! Probability > 0.9 + CANDAT(2,I) .GT. 4. ! Energy > 4 GeV + ) Then ZES_NcandG_si = ZES_NcandG_si + 1 EndIf EndDo C --------------------------------- C --- Calorimeter information --- C --------------------------------- ZES_Eeu_si = CANDAT(2,Icand) ZES_Xeu_si = CANDAT(3,Icand) ZES_Yeu_si = CANDAT(4,Icand) ZES_Zeu_si = CANDAT(5,Icand) ZES_Prob_si = CANDAT(1,Icand) ZESTMP_Ncell_si = MIN(POSDAT(3,Icand),50) !!! store <= 50 cells C --- temp. storage of cell numbers for hadronic variables --- DO I=1,ZESTMP_Ncell_si ZESTMP_CellList_si(I) = POSDAT(3+I,Icand) ENDDO tmp_x = ZES_Xeu_si - XV(1) tmp_y = ZES_Yeu_si - XV(2) tmp_z = ZES_Zeu_si - XV(3) ZES_theta_si = ATan2(sqrt(tmp_x**2 + tmp_y**2), & tmp_z) ZES_phi_si = atan2(tmp_y,tmp_x) ZES_pt_si = ZES_Eeu_si*sin(ZES_theta_si) C ----------------------------------- C --- corrected electron energy --- C ----------------------------------- CALPOS(1) = ZES_Xeu_si CALPOS(2) = ZES_Yeu_si CALPOS(3) = ZES_Zeu_si CALL SiraEnergyCorrection(ICand, XV(3), .true., & ECorr, ECorrError, dCellGap, dModGap) ZES_Ecorr_si = Ecorr(3) C ----------------------------------- C --- electron cone isolation ? --- C ----------------------------------- Radius(1) = 0.8 !!! cone around electron Ncones = 1 !!! test only one cone CALL IsoCones(CALPOS, Radius, Ncones, XV, & ZESTMP_CellList_si, ZESTMP_Ncell_si, & EInDummy, ENotInDummy,RElec, & EMCenrgy,HACenrgy) ZES_Ein_si = EInDummy (1) ZES_ENin_si = ENotInDummy(1) C -------------------------- C --- SRTD information --- C -------------------------- ECAL = ZES_Eeu_si CALL SRTDELEC(XV,CALPOS,ECAL,SRTDC, 1 IDCLU,SPOS,ESRTD,ECORR_SRTD,RDIST,Ierr) ZES_xsrtd_si = SPOS(1) ZES_ysrtd_si = SPOS(2) C SRTD z not stored since it is always the same ZES_Esrtd_si = ESRTD ZES_Fsrtd_si = Ierr C -------------------------------- C --- PRESAMPLER information --- C -------------------------------- CALL PRCLUS(CALPOS, XV(3), PSAME, CENTRAL_TILE, Ierr) IF (Ierr .GE. 0) THEN ZES_Epres1_si = PSAME(1) ZES_Epres2_si = PSAME(2) ZES_Epres3_si = PSAME(3) ENDIF C ------------------------- C --- HES information --- C ------------------------- ZES_XHes_si = CANDAT( 8,Icand) ZES_YHes_si = CANDAT( 9,Icand) ZES_RHes_si = CANDAT(10,Icand) ZES_EHes_si = CANDAT( 7,Icand) C ------------------------------ C --- Tracking information --- C ------------------------------ ZES_TrkMatch_si = CANDAT(17,Icand) !!! track ID in VCPARCAL ENDIF C ---------------------------------------------------------- C --- determine parameters for second electron candidate --- C ---------------------------------------------------------- CALL FINDIS95_second( 1, 0.6, Icand, Ierr) IF (ICand .GT. 0) THEN C --- Do tower to cell island splitting if --- C --- within 60cm of RCAL beam pipe --- IF ((CANDAT(5,Icand) .LT. -140.0) .AND. & (CANDAT(3,Icand)**2 + CANDAT(4,Icand)**2) .LT.3600.0) THEN CALL Tow_to_cIsland(XV,Icand, Ierr) ENDIF C --------------------------------- C --- Calorimeter information --- C --------------------------------- ZES_2Eeu_si = CANDAT(2,Icand) ZESTMP_2Xeu_si = CANDAT(3,Icand) ZESTMP_2Yeu_si = CANDAT(4,Icand) ZESTMP_2Zeu_si = CANDAT(5,Icand) ZES_2Prob_si = CANDAT(1,Icand) ZESTMP_2Ncell_si = MIN(POSDAT(3,Icand),50) !!! store <= 50 cells C --- temp. storage of cell numbers for hadronic variables --- DO I=1,ZESTMP_2Ncell_si ZESTMP_2CellList_si(I) = POSDAT(3+I,Icand) ENDDO tmp_x = ZESTMP_2Xeu_si - XV(1) tmp_y = ZESTMP_2Yeu_si - XV(2) tmp_z = ZESTMP_2Zeu_si - XV(3) ZES_2theta_si = ATan2(sqrt(tmp_x**2 + tmp_y**2), & tmp_z) ZESTMP_2phi_si = atan2(tmp_y,tmp_x) ZES_2pt_si = ZES_2Eeu_si*sin(ZES_2theta_si) C ----------------------------------- C --- electron cone isolation ? --- C ----------------------------------- CALPOS(1) = ZESTMP_2Xeu_si CALPOS(2) = ZESTMP_2Yeu_si CALPOS(3) = ZESTMP_2Zeu_si Radius(1) = 0.8 !!! cone around electron Ncones = 1 !!! test only one cone CALL IsoCones(CALPOS, Radius, Ncones, XV, & ZESTMP_2CellList_si, ZESTMP_2Ncell_si, & EInDummy, ENotInDummy,RElec, & EMCenrgy,HACenrgy) ZES_2Ein_si = EInDummy (1) ENDIF RETURN END