C================================================================== * package to simulate noise in MC identical to data. *-- HOW TO USE? * C 1) add this file somewhere in your eaze.car * 2) copy file noise.rz to your own area; it has to be * submitted to zarah: * jobsub eaze_run -f eaze.car noise.rz * 3) in beginning ZUANAL: call mreco * noise is being added to MC, some noisy cells are removed. * 4) If you want to use better noise cuts: * CALL MNOISESUP(ECUT,VTX,ISLFL,DELFL,NCELLS * + ,SUMENERGY,MOMENTUM,IERR) * * * 5) Please check the memory allocated by HBOOK in call * to hlimit, add 500000 to it to read in the histograms * in noise94.rz. * Check your logfile near hropen of unit 44 on * 'not enough space in memory' * 6) Complains and questions to vreeswijk@nikhef.nl * * * M. Vreeswijk 13 Jul. 1995 C================================================================== C C ========================= subroutine addno94(ikind) C ========================= C IMPLICIT NONE C #include "partap.inc" #include "caltru.inc" integer ikind,nk,i,ii,ic,icalnr,i1,i2,istat,if,err integer cllnr external cllnr real r,hrndm1,ranf,e real aimb,bimb,s1,s2,xpos,ypos,zpos,phi,rpos parameter(nk=10) character*80 name(nk) integer idcel(nk),iden(nk),itrak(nk),ictot(nk),idep(nk) integer icel(nk,2000) logical first integer teken(10) data teken /1, -1, 1, 1 , 1, 1, -1, 1, -1, -1/ C order in teken according to ncel.dat data first /.TRUE./ data name /'becel.dat', + 'fecel.dat', + 'fh1cel.dat', + 'fh0cel.dat', + 'recel.dat', + 'bh2cel.dat', + 'rh1cel.dat', + 'rh0cel.dat', + 'bh1cel.dat', + 'fh2cel.dat' / data iden/401,402,403,404,405,406,407,408,409,430/ data idep/201,202,203,204,205,206,207,208,209,230/ data idcel /411,412,413,414,415,416,417,418,419,431/ C data ictot/1671,1021,337/ data ictot/1695,1045,448,191,512,448,397,184,444,386/ data itrak /0,0,0,0,0,0,0,0,0,0/ if (itrak(ikind).eq.0) then print *,'MARCEL SPARK ENCOUNTERED + OF THE ',ikind,' KIND' itrak(ikind)=1 ii=0 open(22,file=name(ikind)) 10 continue ii=ii+1 read(22,*,ERR=99)icel(ikind,ii) goto 10 99 continue print *,'VERWACHT READ',ictot(ikind),ii close(22) endif if (first) then first=.FALSE. call hropen(44,'noise94' ,'noise94.rz',' ',1024,istat) call hcdir('//noise',' ') call hrin(0,0,0) C print *,'FAKE NOISE ' endif call hcdir('//noise94',' ') r = hrndm1(idcel(ikind)) ic = nint(r) ! number of cells in this event icalnr=getind(caltru,'Cellnr') C print *,'for this noise ncel: ',ikind,ic do 20 i=1,ic call hrndm2(iden(ikind),e,aimb) ! get e and imbalance r = ranf(0.) ii = int(r*ictot(ikind)+1.) ! pick a cell number caltru_cellnr = icel(ikind,ii) call seltab(caltru,icalnr,i1,i2) if (i1.eq.i2) then ! already existing goto 20 ! because not removed from MC else caltru_id = NEXT caltru_e = e caltru_imbal = aimb caltru_t(1) = 0. caltru_t(2) = 0. call instab(caltru) endif 20 continue end C ===================== subroutine NoiseSim94 C ===================== C #include "partap.inc" #include "defgencm.inc" #include "caltru.inc" #include "cconsa.inc" #include "ccghit.inc" C parameter (nspec=10) integer noisy(nspec),teken(nspec) integer i,j,NrCond,ierr Integer Cvec(5),ok character*5 Ckind real Enerccnds(10) data noisy /4280,4406,4854,5780,6200, + 6248,7746,8278,8948,9364 / data teken /1,1,1,-1,1, -1,1,-1,-1,1 / call defgen(genkey) call calibcal do 10 i=1,coutab(caltru) call fettab(caltru,id,i) if (genkey.ne.'DATA') then if (caltru_cellnr.eq.39074) then caltru_e = caltru_e+caltru_imbal caltru_imbal = 0. call reptab(caltru) endif endif do 20 j=1,10 if (caltru_cellnr.eq.noisy(j)) then if (teken(j).gt.0) then e = caltru_e-caltru_imbal else e = caltru_imbal+caltru_e endif caltru_e = e caltru_imbal = 0. call reptab(caltru) endif 20 continue if ((caltru_cellnr.eq.37210).or. + (caltru_cellnr.eq.8284)) then ! HAC0 caltru_e = caltru_e-caltru_imbal caltru_imbal = 0. call reptab(caltru) endiF 10 continue icellnr=getind(CCGHIT,'CPMnr') do 100 i=coutab(caltru),1,-1 call fettab(caltru,id,i) if (caltru_e.lt.0.06) then call deltab(caltru) goto 100 endif if (genkey.ne.'DATA') then call Ccwhat(caltru_cellnr,Ckind,Cvec,ok) if (Ckind(1:1).eq.'F') ii=0 if (Ckind(1:1).eq.'B') ii=10 if (Ckind(1:1).eq.'R') ii=20 jj=0 if (Ckind(2:4).eq.'EMC') jj=1 if (Ckind(2:5).eq.'HAC1') jj=2 if (Ckind(2:5).eq.'HAC2') jj=3 icode=(ii+jj)*1. if (icode.eq.11 .or. + icode.eq.1 .or. + icode.eq.21 .or. + icode.eq.13 .or. + icode.eq.0 .or. + icode.eq.20 .or. + icode.eq.22 .or. + icode.eq.3 .or. + icode.eq.12 .or. + icode.eq.2) then icellnr=getind(CCGHIT,'CPMnr') do 110 l=0,1 Ccghit_CPMnr=caltru_cellnr+l*1. call seltab(ccghit,icellnr,i3,i4) if ((i4.lt.i3).or.(i3.le.0)) then ! noise cell found call deltab(caltru) goto 100 endif 110 continue endif ! code endif ! NO DATA 100 continue IF (genkey.ne.'DATA') THEN call addno94(1) call addno94(2) call addno94(3) call addno94(4) call addno94(5) call addno94(6) call addno94(7) call addno94(8) call addno94(9) call addno94(10) ENDIF DO 30 i=1,10 Enerccnds(i)=-1. 30 CONTINUE CALL PCCnds (Enerccnds,NrCond,IErr) END C ================================================== SUBROUTINE MNOISESUP94(ECUT,VTX,ISLFL,DELFL,NCELLS + ,SUMENERGY,MOMENTUM,IERR) C ================================================== C IMPLICIT NONE C #include "partap.inc" #include "caltru.inc" #include "cconsa.inc" #include "noisecm.inc" LOGICAL GO,OK REAL cutimb REAL ECUT(2), VTX, SUMENERGY, MOMENTUM(3) INTEGER NCELLS, IERR LOGICAL ISLFL, DELFL REAL DEFAULTCUT(2) DATA DEFAULTCUT /0.1, 0.15/ data cutimb /0.8/ INTEGER I, J, NUM, SEC, EMC, HAC PARAMETER (EMC=1, HAC=2) LOGICAL IER, FIRST, MFIRST DATA MFIRST /.TRUE./ DATA FIRST /.TRUE./ REAL X, Y, Z, THETA, PHI 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 isafe,icacon,ncelcon integer ispec,nspec real Ecutspec parameter (nspec=10) icacon = getind(caltru,'CConSa') IERR = 0 NCELLS = 0 SUMENERGY = 0. CALL VZERO(NUM_CELLS,NISLANDMAX) CALL VZERO(NOISEID,MAXIMUMID) CALL VZERO(MOMENTUM,3) DO I = EMC, HAC IF (ECUT(I).LT.0.) ECUT(I) = DEFAULTCUT(I) ENDDO IF (FIRST) THEN FIRST = .FALSE. WRITE(*,'(A20)') ' ********************************** ' WRITE(*,'(A20)') ' NOISE SUPPRESSION (MV94) ' WRITE(*,'(A20,F6.3)') ' ENERGYCUT EMC ', ECUT(1) WRITE(*,'(A20,F6.3)') ' ENERGYCUT HAC ', ECUT(2) WRITE(*,'(A20,L5)') ' ISLAND FLAG ', ISLFL WRITE(*,'(A20,L5)') ' DELETE FLAG ', DELFL WRITE(*,'(A20)') ' ********************************** ' ENDIF IF (COUTAB(CALTRU).EQ.0) THEN IERR = 1 RETURN ENDIF IF (ISLFL) THEN IF (COUTAB(CALTRU).GT.NCELLMAX) THEN WRITE(*,'(A50)') + ' WARNING: TOO MUCH 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 10 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 GO=.FALSE. IF ((CALTRU_CCONSA.EQ.INULL).AND.CHECK) THEN GO=.TRUE. ELSE call natrel(caltru,caltru_cconsa,cconsa,ok) if (ok) then ncelcon=cconsa_Ncemc+cconsa_NcHac1+cconsa_NcHac2 if (ncelcon.eq.1) GO=.TRUE. endif ENDIF IF (GO) then NUM = ISHFT(IAND(CALTRU_CELLNR,15),-1) IF (NUM.EQ.0) THEN IERR = -1 RETURN ELSE IF (NUM.LE.4) THEN SEC = EMC ELSE IF (NUM.LE.7) THEN SEC = HAC ENDIF Ecutspec=Ecut(sec) IF ((CALTRU_E.LT.Ecutspec).or. + (abs(caltru_imbal/caltru_e).gt.cutimb)) THEN NCELLS = NCELLS + 1 SUMENERGY = SUMENERGY + CALTRU_E CALL CCCXYZ(CALTRU_CELLNR,X,Y,Z,IER) THETA = ATAN2(SQRT(X**2+Y**2),(Z-VTX)) PHI = ATAN2(Y,X) MOMENTUM(1) = MOMENTUM(1) + CALTRU_E*SIN(THETA)*COS(PHI) MOMENTUM(2) = MOMENTUM(2) + CALTRU_E*SIN(THETA)*SIN(PHI) MOMENTUM(3) = MOMENTUM(3) + CALTRU_E*COS(THETA) IF (DELFL) THEN CALL DELTAB(CALTRU) ELSE IF (NCELLS.LT.MAXIMUMID) THEN NOISEID(NCELLS) = CALTRU_ID ELSE WRITE(*,'(A28)') ' TOO MANY NOISE CELLS FOUND ' ENDIF ENDIF ENDIF ENDIF 10 continue END