Subroutine lpszes(Iflag,Xl,pxl,pyl,tktosta,DocaP,Chi2NDof) ********************************************************************* * Roberto Sacchi and Laura Iannotti * LPS informations: * output: * Iflag (real) => validity flag (genuine LPS event) * =1 (all is OK) * =0 run not calibrated or LPS not in acquisition * =-1 error in lp2recon * =-2 no trak found * =-3 no coordinate associated to the traks * * pxl (real) => P_x of proton * pyl (real) => P_y of proton * xL (real) => x_L of proton * tktosta (real) => flag to see which station * partecipate to the track: * 1 = triple coincidence S4,S5,S6 * 2 = double coincidence S4,S5 * 3 = double coincidence S4,S6 * 4 = double coincidence S5,S6 * 5 = triple coincidence S1,S2,S3 * 6 = double coincidence S1,S2 * 7 = double coincidence S1,S3 * 8 = double coincidence S2,S3 * DocaP (real) => distance of the track from the beam pipe * Chi2NDof (real) => chisq/ndof * * Should run on normal 'EVT' triggers, please no 'BOR' or 'ENV' * ********************************************************************* Implicit None C C Common blocks C ============= #include "lpevtr.inc" #include "zrevt.inc" #include "lptrak.inc" #include "lphead.inc" #include "partap.inc" #include "lpcoor.inc" #include "lpcotr.inc" #include "zecpbm.inc" C C Arguments C ========= Real Iflag Real t,Xl,Chi2NDof,Pt,DocaP C C Local variables C =============== Integer ITra Integer Missing(2), NumMiss, NumOops, LastPot Integer TheBest, TheBestN, Laststa Integer EvtInd Integer infl,supl,hpos,OldRun,coind Integer IErr0 Integer cs1,cs2,cs3,cs4,cs5,cs6 Logical FIRST,OK Integer cur1,cur2,CUR Real DocaPipe(6), DistPot(9), MissProb Real TheBestC2,pxL,pyL,tktosta Real Pt2 Character*16 CNAM(2) Character*4 CORD(2) C Integer NTra Parameter (NTra=20) c Real Dummy Parameter (Dummy=-999.) C Real Pmass2 Parameter(Pmass2=0.93827231**2) C Integer NRun Parameter (NRun=302) Integer run(NRun) C C External References C =================== Integer JBIT C C Block Data C ========== DATA FIRST/.TRUE./ DATA CNAM/'RunNr','EvtF'/ DATA CORD/'ASC','ASC'/ DATA OldRun/-1/ C DATA RUN/ 11548, > 11573, 11586, 11587, 11593, 11636, 11637, 11638, > 11640, 11642, 11653, 11661, 11663, 11665, 11683, > 11713, 11714, 11715, 11792, 11793, 11806, 11807, > 11817, 11818, 11819, 11820, 11821, 11822, 11823, > 11824, 11825, 12019, 12020, 12021, 12022, 12023, > 12025, 12026, 12029, 12075, 12076, 12077, 12139, > 12140, 12143, 12144, 12146, 12148, 12158, 12159, > 12161, 12162, 12163, 12164, 12171, 12172, 12173, > 12187, 12188, 12190, 12191, 12192, 12538, 12546, > 12547, 12548, 12561, 12562, 12563, 12564, 12576, > 12614, 12616, 12619, 12622, 12623, 12629, 12630, > 12631, 12636, 12637, 12650, 12671, 12672, 12673, > 12685, 12693, 12695, 12696, 12697, 12705, 12706, > 12707, 12718, 12729, 12732, 12733, 12734, 12748, > 12749, 12750, 12751, 12758, 12759, 12760, 12761, > 12788, 12789, 12827, 12828, 12829, 12830, 12853, > 12854, 12855, 12872, 12873, 12874, 12875, 12884, > 12885, 12886, 12906, 12907, 12908, 12909, 12910, > 12911, 12983, 12985, 12990, 12991, 13002, 13004, > 13045, 13051, 13057, 13067, 13086, 13088, 13093, > 13126, 13134, 13135, 13136, 13145, 13146, 13149, > 13150, 13151, 13152, 13153, 13156, 13157, 13158, > 13169, 13170, 13171, 13173, 13174, 13175, 13176, > 13179, 13180, 13181, 13182, 13183, 13184, 13186, > 13187, 13192, 13200, 13201, 13202, 13203, 13213, > 13214, 13215, 13216, 13217, 13218, 13223, 13224, > 13229, 13230, 13232, 13239, 13241, 13242, 13254, > 13255, 13256, 13271, 13284, 13285, 13298, 13299, > 13315, 13316, 13327, 13328, 13329, 13378, 13391, > 13392, 13393, 13395, 13402, 13404, 13410, 13421, > 13424, 13440, 13441, 13445, 13458, 13459, 13478, > 13479, 13488, 13492, 13496, 13501, 13527, 13556, > 13558, 13559, 13562, 13563, 13564, 13575, 13578, > 13582, 13599, 13601, 13612, 13656, 13663, 13678, > 13685, 13690, 13702, 13704, 13726, 13735, 13736, > 13751, 13752, 13762, 13768, 13769, 13778, 13779, > 13794, 13795, 13796, 13804, 13805, 13807, 13817, > 13818, 13844, 13854, 13876, 13877, 13878, 13879, > 13880, 13881, 13890, 13901, 13909, 13910, 13911, > 13912, 13913, 13914, 13915, 13950, 13952, 13968, > 13990, 13991, 13993, 14027, 14028, 14035, 14036, > 14054, 14076, 14084, 14085, 14092, 14098, 14124, > 14146, 14219, 14223, 14235, 14236, 14265, 14395/ C SAVE FIRST,EvtInd SAVE OldRun C C switch off check on the gafs for MC data IF(ZREVT_RUNNR.lt.10000) goto 1 IF(FIRST) THEN C Create index on LPEvtR on first call CALL CREIND(LPEvtR,EvtInd,'EvtInd',2,CNAM,CORD) FIRST = .FALSE. ENDIF C C No errors sofar Iflag = 1. C --------------------------------------- C First check validity of this run/event. C --------------------------------------- IF(COUTAB(LPHEAD).Eq.0) THEN C -- LPS not taking part to the run C Iflag = 0. GOTO 99 ENDIF C Fetch event header LPHEAD_ID =1 CALL GETTAB(LPHEAD) IF(JBIT(LPhead_SCSTATUS,1).Eq.1) THEN C -- LPS is not in data taking position C Iflag = 0. GOTO 99 ENDIF C C Check if the event has been calibrated C (this check is later duplicated in the code) C IF(LPEVTR_RunNr.NE.OLDRUN) THEN C Fetch LPScalibration from Gaf CALL LPLCAT('LPScalibration1',IErr0) IF(IErr0.GT.0) THEN c No calibration constants for this period !!! Iflag = 0. GOTO 99 ENDIF ENDIF C get KEY ready LPEvtR_RunNr = ZREVT_RunNr LPEvtR_EvtF = ZREVT_EvtNr(3) C C Fetch entry from LPEvtR with EvtF just smaller/equal to EvtNr(3) CALL SELTAB(LPEVTR,EvtInd,Cur1,Cur2) IF(Cur2.NE.0) THEN CALL FETTAB(LPEVTR,EvtInd,Cur2) ELSE C -- This run was not calibrated C Iflag = 0. GOTO 99 ENDIF C C Check if Run/Event really falls in validity IF((LPEVTR_RunNr.NE.ZREVT_RunNr).OR. > (LPEVTR_EvtF .GT.ZREVT_EvtNr(3)).OR. > (LPEVTR_EvtL .LT.ZREVT_EvtNr(3))) THEN C -- This event has not been calibrated C Iflag = 0. GOTO 99 ENDIF C C Cross check with the list of aviailable runs IF(LPEVTR_RunNr.NE.OLDRUN) THEN c c fetch pointer to the new run number infl = 1 supl = NRun c 10 continue if(supl.lt.infl) then c -- Run not found in this list Iflag = 0. GOTO 99 c endif c hpos = (supl+infl)/2 c if(LPEVTR_RunNr.lt.run(hpos)) then supl = hpos - 1 goto 10 elseif(LPEVTR_RunNr.gt.run(hpos)) then infl = hpos + 1 goto 10 else c run found oldrun = run(hpos) endif endif c C -------------------------------- C Then call the LPS reconstruction C -------------------------------- 1 CALL LPEAZE(IErr0) IF(IErr0.NE.0) THEN Iflag = -1. GOTO 99 ENDIF C C Set the validity flag Iflag = 1. c C Initialize all the variables TheBestN = 0 TheBest = 0 Xl = Dummy t = Dummy Pt = Dummy DocaP = Dummy Chi2NDof = Dummy PxL = Dummy PyL = Dummy LastSta = 0 tktosta = 0. cs1 = 0 cs2 = 0 cs3 = 0 cs4 = 0 cs5 = 0 cs6 = 0 C IF(COUTAB(LPTRAK).LE.0) THEN C -- No tracks found Iflag = -2. GOTO 99 ENDIF C C Loop over traks in multiple track events. DO ITra=1,MIN(COUTAB(LPTRAK),NTra) CALL FETTAB(LPTRAK,ID,ITra) CALL LP2FIT( 5, DocaPipe, DistPot, LastPot, + Missing, NumMiss, MissProb, NumOops ) c Chi2NDof = LPTRAK_Chisq/REAL(LPTRAK_Ndof) IF ((LPTRAK_Nhit.GT.TheBestN).OR. + (LPTRAK_Nhit.EQ.TheBestN.AND.Chi2NDof.LT.TheBestC2)) THEN TheBest = ITra TheBestC2 = Chi2NDof TheBestN = LPTRAK_Nhit ENDIF ENDDO C C Fix the best Track C IF(TheBest.GT.0) Then CALL FETTAB(LPTRAK,ID,TheBest) C CALL LP2FIT( 5, DocaPipe, DistPot, LastPot, + Missing, NumMiss, MissProb, NumOops ) LastSta = LastPot IF (LastSta.GT.3) LastSta = (LastPot+4)/2 C DocaP = DocaPipe(LastSta) Chi2NDof = LPTRAK_Chisq/REAL(LPTRAK_Ndof) Pt2 = LPTRAK_P(1)**2+LPTRAK_P(2)**2 Xl = Pt2 + LPTRAK_P(3)**2 pxL = LPTRAK_P(1) pyL = LPTRAK_P(2) c IF(Pt2.GT.0) Pt = SQRT(Pt2) IF(Xl.GT.0) THEN c T. Haas: Use proper Proton beam energy c Xl = SQRT(Xl)/820. Xl = SQRT(Xl)/BEAMOM(1) t = -(Pt2/Xl + Pmass2*(Xl-1)**2/Xl) ENDIF COIND = GETIND(LPCOTR,'LPTRAK') CALL NAFREL(LPTRAK,LPCOTR_LPTRAK,LPCOTR,COIND,cur1,cur2) C IF(cur1.GT.cur2) THEN !1 write (78,*) ' Sacchi che combini?' ELSE DO CUR=cur1,cur2 !2 CALL FETTAB(LPCOTR,COIND,CUR) CALL NATREL(LPCOTR,LPCOTR_LPCOOR,LPCOOR,OK) IF(.NOT.OK) THEN Iflag=-3. ENDIF IF(LPCOOR_STA.EQ.1) THEN cs1=1 ELSEIF(LPCOOR_STA.EQ.2) THEN cs2=1 ELSEIF(LPCOOR_STA.EQ.3) THEN cs3=1 ELSEIF(LPCOOR_STA.EQ.4) THEN cs4=1 ELSEIF(LPCOOR_STA.EQ.5) THEN cs5=1 ELSEIF(LPCOOR_STA.EQ.6) THEN cs6=1 ENDIF ENDDO ENDIF ENDIF IF(cs4.eq.1.and.cs5.eq.1.and.cs6.eq.1) then tktosta=1. ELSEIF(cs4.eq.1.and.cs5.eq.1.and.cs6.eq.0) then tktosta=2. ELSEIF(cs4.eq.1.and.cs5.eq.0.and.cs6.eq.1) then tktosta=3. ELSEIF(cs4.eq.0.and.cs5.eq.1.and.cs6.eq.1) then tktosta=4. ELSEIF(cs1.eq.1.and.cs2.eq.1.and.cs3.eq.1) then tktosta=5. ELSEIF(cs1.eq.1.and.cs2.eq.1.and.cs3.eq.0) Then tktosta=6. ELSEIF(cs1.eq.1.and.cs2.eq.0.and.cs3.eq.1) Then tktosta=7. ELSEIF(cs1.eq.0.and.cs2.eq.1.and.cs3.eq.1) Then tktosta=8. ENDIF c 99 RETURN END ********** END ZES **********************************