C ============================================ SUBROUTINE NOISE95M(RUN,ECUT,IMBACUT,NSIGMA, & ISLFL,DELFL,NCELLS,IERR) C ============================================ C C--------------------------------------------------------------------- C C Input parameters : C C INPUT : C RUN : RUN NUMBER (input RUN<1000 for MC) C ECUT(1) : ENERGY THRESHOLD FOR EMC CELLS IN GEV (DEFAULT: 0.08) C ECUT(2) : ENERGY THRESHOLD FOR HAC CELLS IN GEV (DEFAULT: 0.14) C C IMBACUT : Cut of relative imbalance (absolute value) C Imbacut < 0 : choose default value (DEFAULT: 0.7) C for isolated cells with E < 0.7 GEV C ----------------------------------- C If you don't dare to apply an imbalance cut choose C a high value, i.e. Imbacut = 2. C C NSIGMA : Number of standard deviation from the mean C value of noise (only apply to noisy cells C which cannot be corrected by using the cell's C imbalance information). C C ISLFL : ISLAND FLAG C DELFL : DELETE FLAG C C OUTPUT : NCELLS : NUMBER OF NOISE CELLS 'TOUCHED' BY THIS ROUTINE C C IERR : 0 : NORMAL C -1 : ERROR (CalTru_CellNr not exist) C -2 : ERROR (relation CalTru_CConSa not ok) C 1 : CALTRU TABLE EMPTY C C C ISLFL : FALSE : CELLS WITH A COMMON BORDER ARE CONSIDERED TO BE ADJACENT C (CONDENSATE ALGORITHM) C THIS IS RECOMMENDED FOR DIS C TRUE : CELLS WITH A COMMON EDGE ARE CONSIDERED TO BE ADJACENT TOO C (ISLAND ALGORITHM) C THIS MIGHT BE USEFUL FOR PEOPLE WORKING WITH ISLANDS, BUT C IS LESS RESTRICTIVE C DELFL : TRUE : NOISE CELLS ARE REMOVED FROM CALTRU C FALSE : NOISE CELLS ARE NOT REMOVED FROM CALTRU BUT STORED IN THE C COMMON /NOISECM95/ C C COMMON /NOISECM95/ : POINTER TO NOISE CELLS : NOISEID(I) I=1,NCELLS C C********************************************************************** C NB: before using condensates/ cluster they have to be refilled C using, e.g. the s/r PCCNDS,PCSLCT and PCIDCO/PCIDCL C ( --> description in PHANTOM documentation ) C********************************************************************** C C----------------------------------------------------------------------------- C C AUTHOR : Reinhold Seifert (VXDESY::SEIFERT) ----> for Noise94 C DATE : Sep 22, 1995 C C----------------------------------------------------------------------------- C --DATE--:--NAME--:--MODIFICATIONS------------------------------------------- C OCT '96 Ming adapt for '95 C MAY '97 AQ noisy cells in DATA statement instead of ip-file C c The file 'noscell95.list', which will be read by this code, c contains the list of identified noisy cells, some information c about its noise distribution, and the method of treating these c noisy cells. These information will be read into the array c 'cellinfo'. c c cellinfo(1,i) -> cell id c cellinfo(2,i) -> run range start \ run range in which the c cellinfo(3,i) -> run range end / cell is noisy. c cellinfo(4,i) -> noise max energy c cellinfo(5,i) -> noise mean c cellinfo(6,i) -> noise width c cellinfo(7,i) -> noise code ... 1 2 3 4 c c *** NOTE *** The treatments for the identified noisy cells should c only be done on the DATA and NOT MC events (since most c of the identified noisy cells were only noisy for part c of the runs taken in 1995). In order to distinguish between c data and MC, the user can simply input a run number that c is less than 1000 (run<1000). c c This code should only be valid for '95 analysis since c the noisy cells vary in different years. C----------------------------------------------------------------------------- IMPLICIT NONE #include "partap.inc" #include "caltru.inc" #include "cconsa.inc" INTEGER RUN REAL ECUT(2) REAL DECUT(2) DATA DECUT /0.080, 0.140/ REAL IMBACUT REAL DIMBACUT DATA DIMBACUT /0.7/ C LIMIT THE IMBALANCE CUT ON CELLS .LT. ELIMCUT REAL ELIMCUT DATA ELIMCUT /0.700/ INTEGER NCELLS,IERR LOGICAL ISLFL, DELFL REAL CALCUT(3) DATA CALCUT /0.060, 0.100, 0.110/ C cut in noise width INTEGER NSIGMA INTEGER MAXCELL PARAMETER (MAXCELL=5918) REAL ENERGY(MAXCELL), IMBALA(MAXCELL) INTEGER CELLNR(MAXCELL) LOGICAL CORREC(MAXCELL) INTEGER NCELLMAX, NISLANDMAX PARAMETER (NCELLMAX=600, NISLANDMAX=200) INTEGER NISLAND, CELNUM, ERRIS, ISLAND(NCELLMAX), & POSERNR(NCELLMAX), NUM_CELLS(NISLANDMAX) REAL E_CELL(NCELLMAX) LOGICAL CHECK INTEGER EMC, HAC, HAC0, HAC12 PARAMETER (EMC=1, HAC=2, HAC0=2, HAC12=3) REAL ECSECT, CENE, CIMB INTEGER NUM, SEC INTEGER I, J, Ncc LOGICAL ok, FLAG, COR LOGICAL ISOLA LOGICAL FIRST DATA FIRST /.TRUE./ integer numcell,chkflg PARAMETER (NUMCELL=35) real cellinfo(7,NUMCELL) real tmp_cellinfo(7,NUMCELL) real rddata(7) integer maximumid parameter (maximumid=1000) integer noiseid(maximumid) common/noisecm95/noiseid DATA TMP_CELLINFO/ & 5702. , 12364. , 12370. , 0.196 , 0. , 0. , 4., & 5718. , 11543. , 12370. , 0.251 , 0.200 , 0.0187 , 2., & 5718. , 12424. , 13051. , 0.190 , 0.112 , 0.0202 , 2., & 5720. , 11543. , 12370. , 0.303 , 0.224 , 0.0302 , 2., & 5720. , 12424. , 13051. , 0.160 , 0.109 , 0.0188 , 2., & 8500. , 11548. , 11822. , 0.282 , 0. , 0. , 3., & 8500. , 13459. , 13463. , 0.14 , 0. , 0. , 3., & 5724. , 12424. , 13203. , 0.249 , 0.073 , 0.0556 , 2., & 5726. , 12424. , 13203. , 0.247 , 0.143 , 0.0367 , 2., & 5740. , 12424. , 12900. , 0.237 , 0.154 , 0.0327 , 2., & 5742. , 12424. , 12900. , 0.242 , 0.148 , 0.0292 , 2., & 6302. , 12208. , 12214. , 0. , 0. , 0. , 3., & 19666. , 13093. , 13271. , 0.233 , 0.128 , 0.0550 , 2., & 20644. , 12538. , 12548. , 0.301 , 0.182 , 0.0661 , 2., & 20644. , 12788. , 12794. , 0.301 , 0.182 , 0.0661 , 2., & 20674. , 11543. , 12370. , 0.260 , 0.173 , 0.0230 , 2., & 21542. , 12957. , 14264. , 0.2 , 0.107 , 0.0354 , 2., & 21560. , 13654. , 14396. , 0.533 , 0.329 , 0.0818 , 2., & 21560. , 12076. , 12173. , 0. , 0. , 0. , 3., & 21590. , 13458. , 13463. , 0. , 0. , 0. , 3., & 22134. , 14035. , 14122. , 0.267 , 0.153 , 0.0591 , 2., & 22134. , 14361. , 14396. , 0.267 , 0.153 , 0.0591 , 2., & 23764. , 11543. , 12707. , 0.225 , 0.116 , 0.0305 , 3., & 23764. , 12884. , 14397. , 0.225 , 0.116 , 0.0305 , 3., & 27234. , 11543. , 12875. , 0.235 , 0.128 , 0.0297 , 3., & 27234. , 13237. , 14397. , 0.235 , 0.128 , 0.0297 , 3., & 29250. , 12119. , 12199. , 0.241 , 0.167 , 0.0331 , 2., & 29250. , 12453. , 12497. , 0.241 , 0.167 , 0.0331 , 2., & 29266. , 11543. , 14397. , 0.225 , 0.140 , 0.0114 , 2., & 31768. , 13002. , 13203. , 0.2 , 0.135 , 0.0191 , 2., & 18620. , 12956. , 13271. , 0.287 , 0.173 , 0.0358 , 2., & 23260. , 13890. , 14254. , 0.225 , 0. , 0. , 4., & 27230. , 13308. , 14395. , 0.257 , 0.0873, 0.0537 , 2., & 30846. , 12497. , 12760. , 0.213 , 0.0584, 0.0513 , 2., & 31804. , 12313. , 12371. , 0. , 0. , 0. , 3./ c ............................................................................. IF( IMBACUT.LT.0. ) IMBACUT=DIMBACUT if( ECUT(1).LT.0. ) ECUT(1)=DECUT(1) if( ECUT(2).LT.0. ) ECUT(2)=DECUT(2) IF (FIRST) THEN FIRST=.FALSE. WRITE(*,'(A40)') ' ********************************** ' WRITE(*,'(A40)') ' NOISE95 suppression V1.0 ' WRITE(*,'(A30,F6.3)') ' ENERGYCUT EMC ', ECUT(1) WRITE(*,'(A30,F6.3)') ' ENERGYCUT HAC ', ECUT(2) WRITE(*,'(A30,F6.3)') ' IMBALANCE CUT ', IMBACUT WRITE(*,'(A30,F6.3)') ' ENERGY LIMIT FOR IMBACUT ', ELIMCUT WRITE(*,'(A30,L5)') ' ISLAND FLAG ', ISLFL WRITE(*,'(A30,L5)') ' DELETE FLAG ', DELFL WRITE(*,'(A40)') ' ********************************** ' do i=1,7 do j=1,NUMCELL IF (J .LE. NUMCELL) THEN CELLINFO(I,J) = TMP_CELLINFO(I,J) ELSE CELLINFO(I,J) = 0. ENDIF enddo enddo ENDIF IF (COUTAB(CALTRU).EQ.0) THEN IERR = 1 RETURN ENDIF IERR = 0 NCELLS = 0 CALL VZERO(NUM_CELLS,NISLANDMAX) CALL VZERO(NOISEID,MAXIMUMID) IF (ISLFL) THEN IF (COUTAB(CALTRU).GT.NCELLMAX) THEN WRITE(*,'(A50)') + ' WARNING: TOO MANY CELLS FOR THE ISLAND ALGORITHM' WRITE(*,'(A12,I3,A16)') + ' ONLY FIRST ', NCELLMAX, ' CELLS ACCEPTED ' ENDIF CELNUM = MIN(COUTAB(CALTRU),NCELLMAX) DO I = 1, CELNUM CALL FETTAB(CALTRU,ID,I) POSERNR(I) = CALTRU_CELLNR E_CELL(I) = CALTRU_E ENDDO CALL ISLANDS(NISLAND,ISLAND,POSERNR,E_CELL,CELNUM,ERRIS) IF (ERRIS.GT.0) PRINT*, 'WARNING: ERROR IN SUBROUTINE ISLANDS' DO I = 1, CELNUM NUM_CELLS(ISLAND(I)) = NUM_CELLS(ISLAND(I)) + 1 ENDDO ENDIF DO I = COUTAB(CALTRU), 1, -1 CALL FETTAB(CALTRU,ID,I) CHECK = .TRUE. IF (ISLFL) THEN DO J = 1, NISLAND IF (NUM_CELLS(J).GT.1) THEN IF (ISLAND(I).EQ.J) CHECK =.FALSE. ENDIF ENDDO ENDIF ISOLA=.FALSE. IF( (CALTRU_CCONSA.EQ.INULL).OR.(CALTRU_CCONSA.EQ.IANY) )THEN ISOLA=.TRUE. ELSE call natrel(caltru,caltru_cconsa,cconsa,ok) if( ok )then Ncc=cconsa_Ncemc+cconsa_NcHac1+cconsa_NcHac2 if( Ncc.eq.1 ) ISOLA=.TRUE. else print*,' NOISE95M: error: not ok realtion caltru_cconsa' IERR=-2 RETURN endif ENDIF C C is this an isolated cell? C ISOLA = ISOLA.AND.CHECK C C determine the energy cuts to be used C NUM = ISHFT(IAND(CALTRU_CELLNR,15),-1) IF ((NUM.GT.0).AND.(NUM.LE.4)) THEN SEC = EMC ELSE IF (NUM.LE.5) THEN SEC = HAC0 ELSE IF (NUM.LE.7) THEN SEC = HAC12 ELSE IERR = -1 RETURN ENDIF C if not isolated cell -- apply standard CalTru cuts C ( only used for bad PMT list ) IF( .not.ISOLA )THEN ECSECT = CALCUT(SEC) ELSE IF( SEC.EQ.HAC0 .OR. SEC.EQ.HAC12 ) SEC = HAC ECSECT = ECUT(SEC) ENDIF c c check if this cell is a known "noisy" cell c FLAG = .FALSE. chkflg = 0 if (run.gt.1000) then ! this is DATA (not MC) do j=1,numcell if ((caltru_cellnr.eq.cellinfo(1,j)).and. & (run.ge.cellinfo(2,j)).and. & (run.le.cellinfo(3,j))) then if (cellinfo(7,j).eq.2) then ! cut at n sigma chkflg = 2 if (caltru_e.lt. & (cellinfo(5,j)+nsigma*cellinfo(6,j))) then cene = 0. FLAG = .TRUE. else cene = caltru_e endif endif if (cellinfo(7,j).eq.3) then ! imb correction chkflg = 3 if (caltru_imbal.gt.0) then cene = caltru_e - caltru_imbal FLAG = .TRUE. elseif (caltru_imbal.lt.0) then cene = caltru_e + caltru_imbal FLAG = .TRUE. else cene = caltru_e endif endif if (cellinfo(7,j).eq.4) then ! cut at Emax chkflg = 4 if (caltru_e.lt.cellinfo(4,j)) then cene = 0. FLAG = .TRUE. else cene = caltru_e endif endif endif enddo endif C C go ahead for isolated cells C COR = .FALSE. IF( ISOLA )THEN C C IMBALANCE CUT C C PROTECT AGAINST ZERO CIMB = 2. IF( CALTRU_E.NE.0. ) CIMB = ABS(CALTRU_IMBAL/CALTRU_E) IF( CIMB.GT.IMBACUT .AND. CALTRU_E.LT.ELIMCUT )THEN COR=.TRUE. ENDIF C C C ENERGY CUT C IF( CALTRU_E.LT.ECSECT )THEN COR=.TRUE. ENDIF ENDIF C C SOMETHING TO CORRECT? IF( FLAG )THEN IF( CENE.LT.ECSECT )THEN COR = .TRUE. ELSE CALTRU_E = CENE if (chkflg.eq.3) then CALTRU_IMBAL = 0. endif CALL REPTAB(CALTRU) ENDIF ENDIF IF( COR )THEN IF( DELFL ) CALL DELTAB(CALTRU) ENDIF IF( FLAG .OR. COR )THEN C SAMPLE THE 'TOUCHED' CELLS NCELLS = NCELLS + 1 IF (NCELLS.LE.MAXIMUMID) THEN NOISEID(NCELLS) = CALTRU_ID ELSE WRITE(*,'(A28)') ' TOO MANY NOISE CELLS FOUND ' ENDIF ENDIF ENDDO END