SUBROUTINE DIGI (IFLAG) ************************************************************************ *DOC DIFI * *DOC Operation : * *DOC Description : * *DOC Reads : * *DOC Changes : * *DOC Sends : * *DOC Assumes : * *DOC Results : * *DOC Errors : None * * * *DOC References : None * *DOC Created : 8-JUN-1997 Author : Yuri Fisyak * ************************************************************************ * * implicit none * * Formal parameters *____________________ * INTEGER iflag * * Global sections *__________________ * ********************************************************* * * * This file was generated by HUWFUN. * * * ********************************************************* * * Ntuple Id: 400 * Ntuple Title: Digitization for CSC * Creation: 16/07/97 13.37.36 * ********************************************************* * LOGICAL CHAIN CHARACTER*128 CFILE INTEGER IDNEVT,NCHEVT,ICHEVT REAL OBS(13) * COMMON /PAWIDN/ IDNEVT,OBS COMMON /PAWCHN/ CHAIN, NCHEVT, ICHEVT COMMON /PAWCHC/ CFILE * *-- Ntuple Variable Declarations * REAL D_ANOD,D_ACAT,GASGAIN,VOLTAGE,PHI_TILT,RMSCAL,F_ATT,FRACQS &,ADCOUN,RADWIR,TGSTIM,TIMEPS,GATTIK1,GATTIK2,GATTIK3,QCUT,V_DRIFT &,ZWHLNG,STRIPZ,STRIPW,ADCTHR,R0ANOD,COS_TILT,SIN_TILT,RMSNOISE &,RMSFAST,RMSWFAST,PHSHFT,RD0CHA,ZD0CHA,PHIDCH,XDHIT(10),YDHIT(10) &,ZDHIT(10),XGLHIT(10),YGLHIT(10),ZGLHIT(10),RHODHT(10),PHIDHT(10) &,THEDHT(10),DDEDX(10),XEMP(10),PADHIT(10),ADCWIR(50),TIMWI5(50) &,TIMWIR(50),ADCSTR(50),ADCST6(50),TIMST5(50),TIMSTR(50) &,PRBDFT(20),QQDFIT(20),XDFIT(20),WDFIT(20),PHIFIT(20),RHOFIT(20) &,YDFIT(20),ZDFIT(20),YDDFIT(20),ZDDFIT(20) INTEGER IDEV,IDTYPE,NUMWD,NUMBD(4),NSTRIP,NNODES,NOWGRP,NOFLOA &,NOWIRE,IQACUT,NDHIT,IDTRCK(10),IDPART(10),IWHIT(10),ISHIT(10) &,NDWIRE,ITWIRE(50),IDWIRE(50),NDSTRP,ITSTRP(50),IDSTRP(50),NDFIT &,ITFIT(20) * COMMON /PAWCR4/ IDEV,IDTYPE,NUMWD,NUMBD,NSTRIP,NNODES,NOWGRP &,NOFLOA,D_ANOD,D_ACAT,GASGAIN,VOLTAGE,PHI_TILT,RMSCAL,F_ATT &,FRACQS,ADCOUN,RADWIR,TGSTIM,TIMEPS,GATTIK1,GATTIK2,GATTIK3 &,NOWIRE,QCUT,V_DRIFT,ZWHLNG,STRIPZ,STRIPW,IQACUT,ADCTHR,R0ANOD &,COS_TILT,SIN_TILT,RMSNOISE,RMSFAST,RMSWFAST,PHSHFT,RD0CHA,ZD0CHA &,PHIDCH,NDHIT,IDTRCK,IDPART,XDHIT,YDHIT,ZDHIT,XGLHIT,YGLHIT &,ZGLHIT,RHODHT,PHIDHT,THEDHT,DDEDX,IWHIT,ISHIT,XEMP,PADHIT,NDWIRE &,ITWIRE,IDWIRE,ADCWIR,TIMWI5,TIMWIR,NDSTRP,ITSTRP,IDSTRP,ADCSTR &,ADCST6,TIMST5,TIMSTR,NDFIT,PRBDFT,QQDFIT,XDFIT,WDFIT,PHIFIT &,RHOFIT,YDFIT,ZDFIT,YDDFIT,ZDDFIT,ITFIT LOGICAL HEXIST * * Local variables *__________________ * INTEGER IDN, NEVENT, NPRINT, NPRINTF, ID, NEV, IEV,IERR, I REAL PIBY2, ddedxt INTEGER nstrmx PARAMETER( nstrmx = 50) REAL ADC(-nstrmx:nstrmx) real ADCTOT, ADCTO5, RATIO, RHO INTEGER JMAX, iok, ihit, j, ISTRIP, k, ihitmu real ADCMAX, AL, AR, PHILR, PHILHT,PHILOC, XX_EMP, X_EMP real PHIL, ADR, XX, DPHI, DY, DYC, DZ real dphi_yf real ththit, etahit * * More local variables (sh - for Vladik-6 Plots) *__________________ * real adc6(-nstrmx:nstrmx) real adcmx6, adr6, xx6 integer jmax6 * * * Even more local variables (sh - for comparison plots, Jeff's residuals) * real rhophid, rhophif, phi_yf real dmatch, resid integer imatch, ibin real adctot3, dwc, xrel, xw real stnratio * * sh Paw/Hbook memory commons * INTEGER NWPAWC, lrecl REAL PAW * PARAMETER(NWPAWC=1000000) COMMON /PAWC/PAW(NWPAWC) * * sh Ntuple variable declarations REAL RHIT(5) CHARACTER*4 NTTL(5) DATA NTTL / 'ICID','DELX','RESD','RHOD','ETAG'/ * * Executable statements *________________________ * * sh Initialize PAW memory * sh * CALL HLIMIT(NWPAWC) * sh IDN = 400 CALL HBNAME (IDN,' ',0,'$CLEAR') CALL HBNAME (IDN,'CSCPAR',IDEV,'$SET') CALL HBNAME (IDN,'CSCHIT',NDHIT,'$SET') CALL HBNAME (IDN,'CSCWIRE',NDWIRE,'$SET') CALL HBNAME (IDN,'CSCSTRIP',NDSTRP,'$SET') CALL HBNAME (IDN,'CSCFIT', NDFIT ,'$SET') CALL HNBENT (IDN,'CSCPAR',NEVENT) * sh This makes a useful ntuple * if (.not. hexist(42001)) CALL HBOOKN(17,'CSC Rhit',5,' ',1000,NTTL) * sh TYPE NEVENT NPRINT = abs(iflag) piby2 = 2*atan(1.) NEV = NEVENT IF (IFLAG .gt. 0) NEV = nprint DO 1000 IEV = 1, NEV * par ************************************************* CALL HGNTB (IDN, 'CSCPAR', IEV, IERR) IF (IERR .NE. 0) THEN TYPE 'CSCPAR', IERR GOTO 1000 ENDIF if (mod(iev, 10000) .eq. 1 .or. iev .le. nprint) type iev * type iev * type numwd if (iev .le. nprint) then write (*,'(a,10i10)') ' idev, idtype, numv = ', & IDEV,IDTYPE, (NUMBD(i), i = 1, numwd) * type NSTRIP,NNODES,NOWGRP,NOFLOA,D_ANOD,D_ACAT * type GASGAIN,VOLTAGE,PHI_TILT,RMSCAL,F_ATT,FRACQS * type ADCOUN,RADWIR,TGSTIM,TIMEPS,GATTIK1,GATTIK2,GATTIK3 * type NOWIRE,QCUT,V_DRIFT,ZWHLNG,STRIPZ,STRIPW * type IQACUT,ADCTHR,R0ANOD * type COS_TILT,SIN_TILT,RMSNOISE,RMSFAST,RMSWFAST * type PHSHFT,RD0CHA,ZD0CHA,PHIDCH end if ID = 1000*MOD(IDTYPE,100) * type idtype, rmsnoise * hits ************************************************* CALL HGNTB (IDN, 'CSCHIT', IEV, IERR) IF (IERR .NE. 0) THEN TYPE 'CSCHIT', IERR GOTO 1000 ENDIF if (iev .le. nprint) then * TYPE NDHIT * WRITE (*,'(2i3,10f8.3)') (IDTRCK(I),IDPART(I), * & XDHIT(I),YDHIT(I),ZDHIT(I),XGLHIT(I),YGLHIT(I),ZGLHIT(I), * & RHODHT(I),PHIDHT(I),THEDHT(I),DDEDX(I),i=1,ndhit) * write (*,'(10x,2i5,2f8.3)') (IWHIT(I),ISHIT(I), * & XEMP(I),PADHIT(I), I = 1, NDHIT) end if ddedxt = 0. do ihit = 1, ndhit * type ihit, ddedx(i) ddedxt = ddedxt + ddedx(ihit) end do * type ddedxt if (.NOT. hexist(ID+1)) then call hbook1 (id+1,'Deposited energy (keV)',100, 0., 25., 0.) call hbook1 (id+2,'ratio a/a5',100, 0., 10., 0.) end if call hfill (id+1, 1.e6*ddedxt, 0., 1.) do ihit = 1, ndhit * type idpart(ihit), thedht(ihit) if (idpart(ihit) .eq. 5 .or. idpart(ihit) .eq. 6) then * if (abs(thedht(ihit)) .gt. 8.5) go to 1000 ihitmu = ihit rho = rhodht(ihit) go to 121 endif enddo go to 1000 121 continue if (ndhit .ne. 1) go to 1000 * wires ************************************************** CALL HGNTB (IDN, 'CSCWIRE', IEV, IERR) IF (IERR .NE. 0) THEN TYPE 'CSCWIRE', IERR GOTO 1000 ENDIF if (iev .le. nprint) then * TYPE NDWIRE * WRITE (*,'(3i5,3f10.3)') (I,ITWIRE(I),IDWIRE(I),ADCWIR(I), * & TIMWI5(I), TIMWIR(I),I=1,NDWIRE) end if * strips ************************************************** CALL HGNTB (IDN, 'CSCSTRIP', IEV, IERR) IF (IERR .NE. 0) THEN TYPE 'CSCSTRIP', IERR GOTO 1000 ENDIF if (iev .le. nprint) then * WRITE (*,'(2i5,4f10.3)') (ITSTRP(I),IDSTRP(I),ADCSTR(I), * & ADCST6(I), TIMST5(I),TIMSTR(I),I=1,NDSTRP) end if * if (ndwire .ne. 1) go to 1000 if (ndhit .ne. 1) go to 1000 * call vzero (adc(-nstrmx),2*nstrmx+1) adctot = 0.0 adcto5 = 0.0 jmax = -9999 adcmax = - 999. * sh For Vladik-6 adcmx6 = -999 * sh For Vladik plots do i = 1, ndstrp if (abs(IDSTRP(I)) .le. nstrmx) then adctot = adctot + ADCSTR(I) adcto5 = adcto5 + ADCST6(I) j = IDSTRP(I) adc(j) = ADCSTR(I) adc6(j) = adcst6(i) ! sh For Vladik-6 plot * type j, adc(j) if (adc(j) .gt. adcmax) then adcmax = adc(j) jmax = j * jmax = ishit(ihit) endif * sh For Vladik-6 plot if (adc6(j) .gt. adcmx6) then adcmx6 = adc6(j) jmax6 = j endif end if enddo * sh This picks out the muon hits if (jmax .ne. ishit(ihitmu)) then * type ihitmu, jmax, ishit(ihitmu) go to 1000 endif ihit = ihitmu ratio = -1. if (adcto5 .gt. 0.0) ratio = adctot/adcto5 * type jmax, ishit(ihit), adctot, adcto5, ratio call hfill (id+2, ratio, 0., 1.) * if (ndstrp .le. 2 .or. ndstrp .gt. 7) go to 1000 iok = 0 * if (abs(idwire(1)+56) .le. 2) iok = 1 * sh Selects the areas of strips which will give residuals * sh that are the most representative of what to expect * if (idtype.eq.31210) then if (padhit(ihit) .ge. 0.33 .and. & padhit(ihit) .lt. 0.4) iok = 1 else if (idtype.eq.31211) then if (padhit(ihit) .ge. 0.44 .and. & padhit(ihit) .lt. 0.7) iok = 1 else if (idtype.eq.31212) then if (padhit(ihit) .ge. 0.64 .and. & padhit(ihit) .lt. 1.0) iok = 1 else if (idtype.eq.31213) then if (padhit(ihit) .ge. 1.0 .and. & padhit(ihit) .lt. 1.48) iok = 1 else if ((idtype .eq. 31221).or. (idtype .eq. 31222) .or. & (idtype .eq. 31231).or. (idtype .eq. 31232) .or. & (idtype .eq. 31241).or. (idtype .eq. 31242)) then if (padhit(ihit) .ge. 1.3 .and. & padhit(ihit) .lt. 1.6) iok = 1 endif if (iev .le. nprint) type iok * * sh if (jmax .le. -nstrmx .or. jmax .ge. nstrmx) go to 1000 * sh Histogram initialization if (.not. hexist(id+100)) then call hbook1 (id+100,'Total strip ADC', 100, 0., 2000., 0.) call hbook1 (id+111,'Strip width all',120,0., 2.20, 0.) call hbook1 (id+112,'Strip width sel',120,1.2, 1.35, 0.) call hbook2 (id+200,'L vs R', 110, -.1, 1., 110, -.1, 1., & 0.) call hbook2 (id+201, & '"r#((1-L)^2!+(1-R)^2!) C vs atan((1-L)/(1-R))', & 100, 0., 90., 100, 0., 1.5, 0.) call hbprof (id+202, & '"r#((1-L)^2!+(1-R)^2!) C vs atan((1-L)/(1-R))', & 100, 0., 90., 0., 1.5, 'S') call hbook2 (id+210,'L vs R(sel)', 110, -.1, 1., 110, -.1, 1., & 0.) call hbook2 (id+211, & '"r#((1-L)^2!+(1-R)^2!) C vs atan((1-L)/(1-R))(sel)', & 100, 0., 90., 100, 0., 1.5, 0.) call hbprof (id+212, & '"r#((1-L)^2!+(1-R)^2!) C vs atan((1-L)/(1-R))(sel)', & 30, 0., 90., 0., 1.5, 'S') call hbook2 (id+221,'Vladik plot (all)', & 120, -30., 30., 220, -.1, 1.0, 0.) call hbook2 (id+222,'Vladik plot (sel)', & 120, -30., 30., 220, -.1, 1.0, 0.) call hbprof (id+223,'Vladik plot (all)', & 120, -30., 30., -.1, 1.0, 's') call hbprof (id+224,'Vladik plot (sel)', & 120, -30., 30., -.1, 1.0, 's') * call hbook1 (id+251,'Strip Width', 100, 0.5, 1.5, 0.) * call hbook1 (id+252,'RMS Noise',100, 0. ,10000. ,0.) call hbook1 (id+301,'Strip resolution (all)', 100, -.5, .5, 0. & ) call hbook1 (id+302,'Strip resolution (sel)', 100, -.5, .5, 0. & ) call hbook1 (id+303,'Strip resolution (all,corrected)', & 100, -.25, .25, 0.) call hbook1 (id+304,'Strip resolution (sel,corrected)', & 100, -.25, .25, 0.) call hbook1 (id+311,'Wire resolution', 100, -5., 5., 0.) call hbook1 (id+312,'Wire resolution', 100, -5., 5., 0.) * sh For Vladik-6 plot call hbook2 (id+321,'Vladik plot 6 (all)', & 120, -30., 30., 220, -.1, 1.0, 0.) call hbook2 (id+322,'Vladik plot 6 (sel)', & 120, -30., 30., 220, -.1, 1.0, 0.) call hbprof (id+323,'Vladik plot 6 (all)', & 120, -30., 30., -.1, 1.0, 's') call hbprof (id+324,'Vladik plot 6 (sel)', & 120, -30., 30., -.1, 1.0, 's') * sh call hbprof (id+401, '[D]Y vs pad (all)', & 12, -0.5, 0.5, -5000., 5000., 'S') call hbprof (id+402, '[D]Y(all, corrected) vs pad', & 12, -0.5, 0.5, -5000., 5000., 'S') call hbprof (id+403, '[D]Y vs pad (sel)', & 12, -0.5, 0.5, -5000., 5000., 'S') call hbprof (id+404, '[D]Y(sel, corrected) vs pad', & 12, -0.5, 0.5, -5000., 5000., 'S') call hbook2 (id+405, '[D]Y vs pad (sel)', & 12, -0.5, 0.5,100, -2500., 2500, 0.) call hbook2 (id+406, '[D]Y(sel, corrected) vs pad', & 12, -0.5, 0.5,100, -1000., 1000., 0.) call hbook2 (id+408, '[D]Y(sel, very corrected?) vs pad', & 12, -0.5, 0.5,100, -1000., 1000., 0.) * sh Added by Jeff Rowe for his residual plots call hbook2 (id+505, 'resid vs pad (sel)', & 12, -0.5, 0.5, 100, -500., 500., 0.) call hbook2 (id+506, 'resid(sel, corrected) vs pad', & 12, -0.5, 0.5,100, -500., 500., 0.) call hbook1 (id+601, 'resid (bin 1)', 100, -500., 500., 0.) call hbook1 (id+602, 'resid (bin 2)', 100, -500., 500., 0.) call hbook1 (id+603, 'resid (bin 3)', 100, -500., 500., 0.) call hbook1 (id+604, 'resid (bin 4)', 100, -500., 500., 0.) call hbook1 (id+605, 'resid (bin 5)', 100, -500., 500., 0.) * sh Initialize efficiency histogram call hbook1 (id+701, 'Signal-to-Noise',100,0,1000,0.) call hbook1 (id+702, 'Signal-to-Noise, sel',100,0,1000,0.) call hbook1 (id+703, 'Signal-to-Noise, test',100,0,1000,0.) * sh * sh This will compare the fit to yuri's version of the fit. * call hbook2(id+901, 'PHIFIT vs. phif_yuri', * & 100, -0.2, 0.2, 100, -0.2, 0.2, 0.) * call hbook2(id+902, 'PHIDHT vs. phif_yuri', * & 100, -0.2, 0.2, 100, -0.2, 0.2, 0.) * call hbook2(id+903, 'PHIDHT vs. PHIFIT', * & 100, -0.2, 0.2, 100, -0.2, 0.2, 0.) end if call hfill (id+100, adctot, 0., 1.) if (adcmax .gt. 0.) then al = adc(jmax+1)/adc(jmax) ar = adc(jmax-1)/adc(jmax) rho = sqrt((1.-al)**2 + (1.-ar)**2) philr = 90.0 if (ar .lt. 1.0) philr = 90./piby2*atan((1.-al)/(1.-ar)) call hfill (id+200, al, ar, 1.) call hfill (id+201, philr, rho, 1.) call hfill (id+202, philr, rho, 1.) if (iok .eq. 1) then call hfill (id+210, al, ar, 1.) call hfill (id+211, philr, rho, 1.) call hfill (id+212, philr, rho, 1.) endif endif if (iev .eq. 10) type rmsnoise,gasgain * call hfill (id+251,stripw, 0., 1.) * call hfill (id+252, rmsnoise, 0., 1.) rho = rhodht(ihit) call hfill (id+111, padhit(ihit), 0., 1.) if (iok .eq. 1) call hfill (id+112, padhit(ihit), 0., 1.) philoc = - PHIdHT(ihit) ISTRIP = ishit(ihit) * sh Actual distance from strip center xx_emp = XEMP(ihit) * sh Calculate relative distance from strip center x_emp = xx_emp/padhit(ihit) * * sh Signal to noise ratio histogram stnratio = 0.312*adctot / (1.6e-4 * rmsnoise) call hfill (id+701, stnratio, 0., 1.) if (iok .eq. 1) call hfill (id+702, stnratio, 0., 1.) stnratio = 0.5*adctot / (1.6e-4 * rmsnoise) call hfill (id+703, stnratio, 0., 1.) * sh adctot = 0. * sh Another try at S to N * do k = jmax-2, jmax+2 * adctot = adctot + adc(k) * enddo * stnratio = 0.5*adctot / (1.6e-4 * rmsnoise) * sh adctot = 0. do k = jmax-2, jmax+2 * type k, adc(k) if (adc(k) .gt. 0.) adctot = adctot + adc(k) enddo * type adctot if (adctot .le. 0.0) go to 1000 do k = jmax-2, jmax+2 adr = adc(k)/adctot * type k, adr if (adr .gt. 0.) then xx = -xx_emp + padhit(ihit)*(k-jmax) call hfill (id+221, 10.*xx, adr, 1.) call hfill (id+223, 10.*xx, adr, 1.) if (iok .eq. 1) then call hfill (id+222, 10.*xx, adr, 1.) call hfill (id+224, 10.*xx, adr, 1.) endif endif end do * sh For Vladik-6 plot adcto5 = 0. do k = jmax6-2, jmax6+2 if (adc6(k) .gt. 0.) adcto5 = adcto5 + adc6(k) enddo * type adcto5 if (adcto5 .le. 0.0) go to 1000 do k = jmax6-2, jmax6+2 adr6 = adc6(k)/adcto5 * type k, adr6 if (adr6 .gt. 0.) then xx6 = -xx_emp + padhit(ihit)*(k-jmax6) call hfill (id+321, 10.*xx6, adr6, 1.) call hfill (id+323, 10.*xx6, adr6, 1.) if (iok .eq. 1) then call hfill (id+322, 10.*xx6, adr6, 1.) call hfill (id+324, 10.*xx6, adr6, 1.) endif endif enddo * sh * fit ******************************************************* CALL HGNTB (IDN, 'CSCFIT', IEV, IERR) IF (IERR .NE. 0) THEN TYPE 'CSCFIT', IERR GOTO 1000 ENDIF * sh To check the difference between Yuri's and Jeff's residual * sh calculations do i = 1, ndhit dphi_yf = (padhit(i)*(float(ishit(i)) & +phshft)-xdfit(i))/rhodht(i) * type ndhit,i,phidht(i),phifit(i),dphi_yf,phshft rhophid = rhodht(ihit)*phidht(ihit) rhophif = rhodht(ihit)*phifit(ihit) phi_yf = (rhophid-xemp(ihit))/rhodht(ihit) * call hfill (id+901, phifit(ihit), phi_yf, 1.) * call hfill (id+902, phidht(ihit), phi_yf, 1.) * call hfill (id+903, phidht(ihit), phifit, 1.) enddo * sh if (iev .le. nprint) then * TYPE NDFIT * WRITE (*,'(10f10.3,i5)') (PRBDFT(I),QQDFIT(I),XDFIT(I), * & WDFIT(I),PHIFIT(I), RHOFIT(I),YDFIT(I),ZDFIT(I),YDDFIT(I), * & ZDDFIT(I),ITFIT(I), I=1,NDFIT) end if * type rho, ndstrp, idwire(1), padhit(ihit) * sh Yuri's calculations for residual do ihit = ihitmu, ihitmu * sh Gatti fit method used for determining x_average,weighted * sh uses hit variable to do so adctot3 = adc(ishit(ihit)-1)+ adc(ishit(ihit))+ & adc(ishit(ihit)+1) xw = padhit(ihit)*(- adc(ishit(ihit) - 1 ) + & adc(ishit(ihit) + 1 )) / adctot3 dwc= xemp(ihit) - xw * sh * type xw, xemp(ihit), dwc if (iok .eq. 1) call hfill (id+408, xw, 10000.*dwc, 1.) do j = 1, ndfit * sh If there is no fit, throw out event if (xdfit(j) .eq. 0.0) goto 1000 dy = xdhit(ihit) - ydfit(j) * type xdhit(ihit), ydfit(j), dy dyc= xemp(ihit) - xdfit(j) ! correct for R * type xemp(ihit),xdfit(j),dyc dz = zDHIT(ihit) - zDFIT(j) * type zdhit(ihit), zdfit(j), dz if (iev .le. nprintf) & type xx_emp, dy, idpart(ihit),PRBDFT(j) call hfill (id+301, dy, 0., 1.) call hfill (id+303, dyc, 0., 1.) call hfill (id+311, dz, 0., 1.) call hfill (id+401, x_emp, 10000.*dy, 1.) call hfill (id+402, x_emp, 10000.*dyc, 1.) call hfill (id+405, x_emp, 10000.*dyc, 1.) * sh Fills histograms with data from selected padwiths if (iok .eq. 1) then call hfill (id+302, dy, 0., 1.) call hfill (id+304, dyc, 0., 1.) call hfill (id+312, dz, 0., 1.) call hfill (id+403, x_emp, 10000.*dy, 1.) call hfill (id+404, x_emp, 10000.*dyc, 1.) call hfill (id+406, x_emp, 10000.*dyc, 1.) end if enddo * sh Fills ntuple 17, which digi_100.kumac uses to make plots * sh like Jeff makes (2x3 plots), only uses positive values * sh of x_av,weighted (ensures better rms, better resol.) rhit(1) = mod(idtype,100) rhit(2) = x_emp rhit(3) = 10000.*dyc RHIT(4) = RHODHT(IHIT) ththit = atan2(sqrt(xglhit(ihit)**2+yglhit(ihit)**2) & ,zglhit(ihit)) etahit = -log(tan(ththit/2.)) rhit(5) = etahit * RHIT(5) = ADCST6(5) * RHIT(6) = ADCST6(4) * RHIT(7) = ADCST6(3) * RHIT(8) = ADCST6(2) * RHIT(9) = ADCST6(1) * RHIT(10)= ADCST6(1)+ADCST6(2)+ADCST6(3)+ADCST6(4) * & +ADCST6(5) call hfn(17,rhit) end do * sh Added by j.rowe to do the hit-fit matching. Match only muons * do ihit = 1, ndhit if (idpart(ihit).eq.5 .or. idpart(ihit).eq.6 ) then imatch = 0 dmatch = 1000000. do j = 1, ndfit if ( abs(phidht(ihit)-phifit(j)) .lt. dmatch ) then imatch = j dmatch = abs(phidht(ihit)-phifit(j)) endif enddo if (imatch .gt. 0) then resid = 10000*rhodht(ihit)*(phidht(ihit)-phifit(imatch)) * type rhodht(ihit), phidht(ihit), phifit(imatch) dy = xdhit(ihit) - ydfit(imatch) * type xdhit(ihit), ydfit(imatch), dy dyc= xemp(ihit) - xdfit(imatch) ! correct for R * type xemp(ihit), xdfit(imatch), dyc dz = zDHIT(ihit) - zDFIT(imatch) * type zdhit(ihit), zdfit(imatch), dz if (iev .le. nprintf) & type xx_emp, dy, idpart(ihit),PRBDFT(imatch) call hfill (id+505, x_emp, resid, 1.) if (iok .eq. 1) call hfill (id+506, x_emp, resid, 1.) ibin = abs( int(xx_emp/0.1) + 1 ) * type id, ibin, resid call hfill (id+600+ibin, resid, 0., 1.) endif endif end do * type ndfit,ndhit * sh Fill efficiency histogram * call hfill (id+701,ndfit,0,1.) 1000 continue * end of DIGI * 999 END