SUBROUTINE TOFROUTINE(XOUT,YOUT,ALPHA) C------------------------------------------------ C W. Menn C C Version 1.00 August 2005 C Version 1.01 7-oct-2005 C changed initialization values of xtofpos and ytofpos to "100." C if the calculated values are unphysical (> +/- 100), then they C are set to "101." to avoid problems in the attenuation calculation C------------------------------------------------ include 'common_tofroutine.f' include 'common_tof.f' c ======================================= c variables for tracking routine c ======================================= parameter(NPOINT_MAX=100) REAL XOUT(NPOINT_MAX),YOUT(NPOINT_MAX) REAL ALPHA(5) * ****************************************************************** * eventcounter c write(*,*) '--- in beta.f ----' * amplitude has to be 'secure' higher than pedestal for an adc event secure = 2. xtop = 1000.0 xmid = 1000.0 xbot = 1000.0 offset = 1 slope = 2 top = 1 mid = 2 bot = 3 left = 1 right = 2 none_ev = 0 none_find = 0 tdc_ev = 1 adc_ev = 1 itdc = 1 iadc = 2 do i=1,5 beta_a(i) = 1000. enddo do i=1,4 do j=1,12 adc_c(i,j) = 1000. enddo enddo c the calibration files are read in the main program from xxx_tofcalib.rz IF (TOFfst.EQ.0) THEN TOFfst = 1 write(*,*) 'Calibration Data' write(*,*) 'K1 data ' write(*,*) 'S11-S31' DO i = 1,24 write(*,*) i,k1_S11S31(i) ENDDO write(*,*) 'S12-S32' DO i = 1,18 write (*,*) i,k1_S12S32(i) ENDDO write(*,*) 'S21-S31' DO i = 1,6 write(*,*) i,k1_S21S31(i) ENDDO write(*,*) 'S22-S32' DO i = 1,6 write (*,*) i,k1_S22S32(i) ENDDO C--- use TDC-difference to calculate incident point write(*,*) 'X-Y-Lin Coordinates' DO i = 1, 8 write(*,*) i,y_coor_lin11(i,1),y_coor_lin11(i,2) ENDDO DO i = 1, 6 write(*,*) i,x_coor_lin12(i,1),x_coor_lin12(i,2) ENDDO DO i = 1, 2 write(*,*) i,x_coor_lin21(i,1),x_coor_lin21(i,2) ENDDO DO i = 1, 2 write(*,*) i,y_coor_lin22(i,1),y_coor_lin22(i,2) ENDDO DO i = 1, 3 write(*,*) i,y_coor_lin31(i,1),y_coor_lin31(i,2) ENDDO DO i = 1, 3 write(*,*) i,x_coor_lin32(i,1),x_coor_lin32(i,2) ENDDO c---------- Time Walk write(*,*) 'Time Walk' DO i = 1,8 write(*,*) i,tw11(left,i), tw11(right,i) ENDDO DO i = 1,6 write(*,*) i,tw12(left,i), tw12(right,i) ENDDO DO i = 1,2 write(*,*) i,tw21(left,i), tw21(right,i) ENDDO DO i = 1,2 write(*,*) i,tw22(left,i), tw22(right,i) ENDDO DO i = 1,3 write(*,*) i,tw31(left,i), tw31(right,i) ENDDO DO i = 1,3 write(*,*) i,tw32(left,i), tw32(right,i) ENDDO c---------- ADC map c read ADC correction file write(*,*) 'ADC Map' write(*,*) 'ADC Map 1' DO i = 1,8 write(*,*) (adcx11(left,i,j),j=1,2) write(*,*) (adcx11(right,i,j),j=1,2) ENDDO DO i = 1,6 write(*,*) (adcx12(left,i,j),j=1,2) write(*,*) (adcx12(right,i,j),j=1,2) ENDDO write(*,*) 'ADC map 2' DO i = 1,2 write(*,*) (adcx21(left,i,j),j=1,2) write(*,*) (adcx21(right,i,j),j=1,2) ENDDO DO i = 1,2 write(*,*) (adcx22(left,i,j),j=1,2) write(*,*) (adcx22(right,i,j),j=1,2) ENDDO write(*,*) 'ADC map 3' DO i = 1,3 write(*,*) (adcx31(left,i,j),j=1,2) write(*,*) (adcx31(right,i,j),j=1,2) ENDDO DO i = 1,3 write(*,*) (adcx32(left,i,j),j=1,2) write(*,*) (adcx32(right,i,j),j=1,2) ENDDO ENDIF c end of reading parameter files c------------------------- get ToF data -------------------------------- c put the adc and tdc values from ntuple into tofxx(i,j,k) variables do j=1,8 tof11(1,j,2) = adc(ch11a(j),hb11a(j)) tof11(2,j,2) = adc(ch11b(j),hb11b(j)) tof11(1,j,1) = tdc(ch11a(j),hb11a(j)) tof11(2,j,1) = tdc(ch11b(j),hb11b(j)) c write(*,*) j,adc(ch11a(j),hb11a(j)),adc(ch11b(j),hb11b(j)) enddo do j=1,6 tof12(1,j,2) = adc(ch12a(j),hb12a(j)) tof12(2,j,2) = adc(ch12b(j),hb12b(j)) tof12(1,j,1) = tdc(ch12a(j),hb12a(j)) tof12(2,j,1) = tdc(ch12b(j),hb12b(j)) enddo do j=1,2 tof21(1,j,2) = adc(ch21a(j),hb21a(j)) tof21(2,j,2) = adc(ch21b(j),hb21b(j)) tof21(1,j,1) = tdc(ch21a(j),hb21a(j)) tof21(2,j,1) = tdc(ch21b(j),hb21b(j)) enddo do j=1,2 tof22(1,j,2) = adc(ch22a(j),hb22a(j)) tof22(2,j,2) = adc(ch22b(j),hb22b(j)) tof22(1,j,1) = tdc(ch22a(j),hb22a(j)) tof22(2,j,1) = tdc(ch22b(j),hb22b(j)) enddo do j=1,3 tof31(1,j,2) = adc(ch31a(j),hb31a(j)) tof31(2,j,2) = adc(ch31b(j),hb31b(j)) tof31(1,j,1) = tdc(ch31a(j),hb31a(j)) tof31(2,j,1) = tdc(ch31b(j),hb31b(j)) enddo do j=1,3 tof32(1,j,2) = adc(ch32a(j),hb32a(j)) tof32(2,j,2) = adc(ch32b(j),hb32b(j)) tof32(1,j,1) = tdc(ch32a(j),hb32a(j)) tof32(2,j,1) = tdc(ch32b(j),hb32b(j)) enddo C---------------------------------------------------------------------- DO i = 1,8 if (abs(tof11(1,i,itdc)).gt.10000.) tof11(1,i,itdc)= 10000. if (abs(tof11(2,i,itdc)).gt.10000.) tof11(2,i,itdc)= 10000. if (abs(tof11(1,i,iadc)).gt.10000.) tof11(1,i,iadc)= 10000. if (abs(tof11(2,i,iadc)).gt.10000.) tof11(2,i,iadc)= 10000. ENDDO DO i = 1,6 if (abs(tof12(1,i,itdc)).gt.10000.) tof12(1,i,itdc)= 10000. if (abs(tof12(2,i,itdc)).gt.10000.) tof12(2,i,itdc)= 10000. if (abs(tof12(1,i,iadc)).gt.10000.) tof12(1,i,iadc)= 10000. if (abs(tof12(2,i,iadc)).gt.10000.) tof12(2,i,iadc)= 10000. ENDDO DO i = 1,2 if (abs(tof21(1,i,itdc)).gt.10000.) tof21(1,i,itdc)= 10000. if (abs(tof21(2,i,itdc)).gt.10000.) tof21(2,i,itdc)= 10000. if (abs(tof21(1,i,iadc)).gt.10000.) tof21(1,i,iadc)= 10000. if (abs(tof21(2,i,iadc)).gt.10000.) tof21(2,i,iadc)= 10000. ENDDO DO i = 1,2 if (abs(tof22(1,i,itdc)).gt.10000.) tof22(1,i,itdc)= 10000. if (abs(tof22(2,i,itdc)).gt.10000.) tof22(2,i,itdc)= 10000. if (abs(tof22(1,i,iadc)).gt.10000.) tof22(1,i,iadc)= 10000. if (abs(tof22(2,i,iadc)).gt.10000.) tof22(2,i,iadc)= 10000. ENDDO DO i = 1,3 if (abs(tof31(1,i,itdc)).gt.10000.) tof31(1,i,itdc)= 10000. if (abs(tof31(2,i,itdc)).gt.10000.) tof31(2,i,itdc)= 10000. if (abs(tof31(1,i,iadc)).gt.10000.) tof31(1,i,iadc)= 10000. if (abs(tof31(2,i,iadc)).gt.10000.) tof31(2,i,iadc)= 10000. ENDDO DO i = 1,3 if (abs(tof32(1,i,itdc)).gt.10000.) tof32(1,i,itdc)= 10000. if (abs(tof32(2,i,itdc)).gt.10000.) tof32(2,i,itdc)= 10000. if (abs(tof32(1,i,iadc)).gt.10000.) tof32(1,i,iadc)= 10000. if (abs(tof32(2,i,iadc)).gt.10000.) tof32(2,i,iadc)= 10000. ENDDO C---------------------------------------------------------------- C------------ Check Paddles for hits ----------------------- C---------------------------------------------------------------- C upper tof S11 DO i = 1,8 DO j = 1,2 tof11_event(j,i) = none_ev IF ((tof11(j,i,itdc).LT.2000).AND.(tof11(j,i,itdc).GT.100)) + tof11_event(j,i) = tof11_event(j,i) + tdc_ev IF ((tof11(j,i,iadc).GT.secure).AND. + (tof11(j,i,iadc).LT.4095)) + tof11_event(j,i) = tof11_event(j,i) + adc_ev ENDDO ENDDO c find single paddle in upper tof with tdc and adc signal tof11_i = none_find tof11_j = none_find check = .TRUE. DO i = 1, 8 IF ((tof11_event(left,i).GE.1).AND.(tof11_event(right,i).GE.1)) + THEN c check if an other paddle has also an event - then set flag tof11_j = tof11_j + 2**(i-1) IF (check.EQV..TRUE.) THEN IF (tof11_i.EQ.none_find) THEN tof11_i = i ELSE tof11_i = -1 check = .FALSE. ENDIF ENDIF ENDIF ENDDO C upper tof S12 DO i = 1,6 DO j = 1,2 tof12_event(j,i) = none_ev IF ((tof12(j,i,itdc).LT.2000).AND.(tof12(j,i,itdc).GT.100)) + tof12_event(j,i) = tof12_event(j,i) + tdc_ev IF ((tof12(j,i,iadc).GT.secure).AND. + (tof12(j,i,iadc).LT.4095)) + tof12_event(j,i) = tof12_event(j,i) + adc_ev ENDDO ENDDO c find single paddle in upper tof with tdc and adc signal tof12_i = none_find tof12_j = none_find check = .TRUE. DO i = 1, 6 IF ((tof12_event(left,i).GE.1).AND.(tof12_event(right,i).GE.1)) + THEN c check if an other paddle has also an event - then set flag tof12_j = tof12_j + 2**(i-1) IF (check.EQV..TRUE.) THEN IF (tof12_i.EQ.none_find) THEN tof12_i = i ELSE tof12_i = -1 check = .FALSE. ENDIF ENDIF ENDIF ENDDO C middle tof S21 DO i = 1,2 DO j = 1,2 tof21_event(j,i) = none_ev IF ((tof21(j,i,itdc).LT.2000).AND.(tof21(j,i,itdc).GT.100)) + tof21_event(j,i) = tof21_event(j,i) + tdc_ev IF ((tof21(j,i,iadc).GT.secure).AND. + (tof21(j,i,iadc).LT.4095)) + tof21_event(j,i) = tof21_event(j,i) + adc_ev ENDDO ENDDO c find single paddle in upper tof with tdc and adc signal tof21_i = none_find tof21_j = none_find check = .TRUE. DO i = 1, 2 IF ((tof21_event(left,i).GE.1).AND.(tof21_event(right,i).GE.1)) + THEN c check if an other paddle has also an event - then set flag tof21_j = tof21_j + 2**(i-1) IF (check.EQV..TRUE.) THEN IF (tof21_i.EQ.none_find) THEN tof21_i = i ELSE tof21_i = -1 check = .FALSE. ENDIF ENDIF ENDIF ENDDO C middle tof S22 DO i = 1,2 DO j = 1,2 tof22_event(j,i) = none_ev IF ((tof22(j,i,itdc).LT.2000).AND.(tof22(j,i,itdc).GT.100)) + tof22_event(j,i) = tof22_event(j,i) + tdc_ev IF ((tof22(j,i,iadc).GT.secure).AND. + (tof22(j,i,iadc).LT.4095)) + tof22_event(j,i) = tof22_event(j,i) + adc_ev ENDDO ENDDO c find single paddle in upper tof with tdc and adc signal tof22_i = none_find tof22_j = none_find check = .TRUE. DO i = 1, 2 IF ((tof22_event(left,i).GE.1).AND.(tof22_event(right,i).GE.1)) + THEN c check if an other paddle has also an event - then set flag tof22_j = tof22_j + 2**(i-1) IF (check.EQV..TRUE.) THEN IF (tof22_i.EQ.none_find) THEN tof22_i = i ELSE tof22_i = -1 check = .FALSE. ENDIF ENDIF ENDIF ENDDO C bottom tof S31 DO i = 1,3 DO j = 1,2 tof31_event(j,i) = none_ev IF ((tof31(j,i,itdc).LT.2000).AND.(tof31(j,i,itdc).GT.100)) + tof31_event(j,i) = tof31_event(j,i) + tdc_ev IF ((tof31(j,i,iadc).GT.secure).AND. + (tof31(j,i,iadc).LT.4095)) + tof31_event(j,i) = tof31_event(j,i) + adc_ev ENDDO ENDDO c find single paddle in upper tof with tdc and adc signal tof31_i = none_find tof31_j = none_find check = .TRUE. DO i = 1, 3 IF ((tof31_event(left,i).GE.1).AND.(tof31_event(right,i).GE.1)) + THEN c check if an other paddle has also an event - then set flag tof31_j = tof31_j + 2**(i-1) IF (check.EQV..TRUE.) THEN IF (tof31_i.EQ.none_find) THEN tof31_i = i ELSE tof31_i = -1 check = .FALSE. ENDIF ENDIF ENDIF ENDDO C bottom tof S32 DO i = 1,3 DO j = 1,2 tof32_event(j,i) = none_ev IF ((tof32(j,i,itdc).LT.2000).AND.(tof32(j,i,itdc).GT.100)) + tof32_event(j,i) = tof32_event(j,i) + tdc_ev IF ((tof32(j,i,iadc).GT.secure).AND. + (tof32(j,i,iadc).LT.4095)) + tof32_event(j,i) = tof32_event(j,i) + adc_ev ENDDO ENDDO c find single paddle in upper tof with tdc and adc signal tof32_i = none_find tof32_j = none_find check = .TRUE. DO i = 1, 3 IF ((tof32_event(left,i).GE.1).AND.(tof32_event(right,i).GE.1)) + THEN c check if an other paddle has also an event - then set flag tof32_j = tof32_j + 2**(i-1) IF (check.EQV..TRUE.) THEN IF (tof32_i.EQ.none_find) THEN tof32_i = i ELSE tof32_i = -1 check = .FALSE. ENDIF ENDIF ENDIF ENDDO do i=1,6 tof_i_flag(i)=0 tof_j_flag(i)=0 enddo tof_i_flag(1)=tof11_i tof_i_flag(2)=tof12_i tof_i_flag(3)=tof21_i tof_i_flag(4)=tof22_i tof_i_flag(5)=tof31_i tof_i_flag(6)=tof32_i tof_j_flag(1)=tof11_j tof_j_flag(2)=tof12_j tof_j_flag(3)=tof21_j tof_j_flag(4)=tof22_j tof_j_flag(5)=tof31_j tof_j_flag(6)=tof32_j C-------------------------------------------------------------------- C-------------------- Time walk correction ------------------------- C-------------------------------------------------------------------- IF (tof11_i.GT.none_find) THEN tof11(left,tof11_i,itdc) = tof11(left,tof11_i,itdc) + + tw11(left,tof11_i)/sqrt(tof11(left,tof11_i,iadc)) tof11(right,tof11_i,itdc) = tof11(right,tof11_i,itdc) + + tw11(right,tof11_i)/sqrt(tof11(right,tof11_i,iadc)) ENDIF IF (tof12_i.GT.none_find) THEN tof12(left,tof12_i,itdc) = tof12(left,tof12_i,itdc) + + tw12(left,tof12_i)/sqrt(tof12(left,tof12_i,iadc)) tof12(right,tof12_i,itdc) = tof12(right,tof12_i,itdc) + + tw12(right,tof12_i)/sqrt(tof12(right,tof12_i,iadc)) ENDIF IF (tof21_i.GT.none_find) THEN tof21(left,tof21_i,itdc) = tof21(left,tof21_i,itdc) + + tw21(left,tof21_i)/sqrt(tof21(left,tof21_i,iadc)) tof21(right,tof21_i,itdc) = tof21(right,tof21_i,itdc) + + tw21(right,tof21_i)/sqrt(tof21(right,tof21_i,iadc)) ENDIF IF (tof22_i.GT.none_find) THEN tof22(left,tof22_i,itdc) = tof22(left,tof22_i,itdc) + + tw22(left,tof22_i)/sqrt(tof22(left,tof22_i,iadc)) tof22(right,tof22_i,itdc) = tof22(right,tof22_i,itdc) + + tw22(right,tof22_i)/sqrt(tof22(right,tof22_i,iadc)) ENDIF IF (tof31_i.GT.none_find) THEN tof31(left,tof31_i,itdc) = tof31(left,tof31_i,itdc) + + tw31(left,tof31_i)/sqrt(tof31(left,tof31_i,iadc)) tof31(right,tof31_i,itdc) = tof31(right,tof31_i,itdc) + + tw31(right,tof31_i)/sqrt(tof31(right,tof31_i,iadc)) ENDIF IF (tof32_i.GT.none_find) THEN tof32(left,tof32_i,itdc) = tof32(left,tof32_i,itdc) + + tw32(left,tof32_i)/sqrt(tof32(left,tof32_i,iadc)) tof32(right,tof32_i,itdc) = tof32(right,tof32_i,itdc) + + tw32(right,tof32_i)/sqrt(tof32(right,tof32_i,iadc)) ENDIF C------------------------------------------------------------------ C--- calculate track position in paddle using timing difference C------------------------------------------------------------------ do i=1,3 xtofpos(i)=100. ytofpos(i)=100. enddo C----------------------------- S1 -------------------------------- IF (tof11_i.GT.none_find) THEN ytofpos(1) = ((tof11(1,tof11_i,itdc)-tof11(2,tof11_i,itdc))/2. + - y_coor_lin11(tof11_i,offset))/y_coor_lin11(tof11_i,slope) endif IF (tof12_i.GT.none_find) THEN xtofpos(1) = ((tof12(1,tof12_i,itdc)-tof12(2,tof12_i,itdc))/2. + - x_coor_lin12(tof12_i,offset))/x_coor_lin12(tof12_i,slope) endif C----------------------------- S2 -------------------------------- IF (tof21_i.GT.none_find) THEN xtofpos(2) = ((tof21(1,tof21_i,itdc)-tof21(2,tof21_i,itdc))/2. + - x_coor_lin21(tof21_i,offset))/x_coor_lin21(tof21_i,slope) endif IF (tof22_i.GT.none_find) THEN ytofpos(2) = ((tof22(1,tof22_i,itdc)-tof22(2,tof22_i,itdc))/2. + - y_coor_lin22(tof22_i,offset))/y_coor_lin22(tof22_i,slope) endif C----------------------------- S3 -------------------------------- IF (tof31_i.GT.none_find) THEN ytofpos(3) = ((tof31(1,tof31_i,itdc)-tof31(2,tof31_i,itdc))/2. + - y_coor_lin31(tof31_i,offset))/y_coor_lin31(tof31_i,slope) c write(*,*) '31',tof31(1,tof31_i,itdc),tof31(2,tof31_i,itdc), c + y_coor_lin31(tof31_i,offset),y_coor_lin31(tof31_i,slope), c + ytofpos(3) endif IF (tof32_i.GT.none_find) THEN xtofpos(3) = ((tof32(1,tof32_i,itdc)-tof32(2,tof32_i,itdc))/2. + - x_coor_lin32(tof32_i,offset))/x_coor_lin32(tof32_i,slope) c write(*,*) '32',tof32(1,tof32_i,itdc),tof32(2,tof32_i,itdc), c + x_coor_lin32(tof32_i,offset),x_coor_lin32(tof32_i,slope), c + xtofpos(3) endif do i=1,3 if (abs(xtofpos(i)).gt.100.) then xtofpos(i)=101. endif if (abs(ytofpos(i)).gt.100.) then ytofpos(i)=101. endif enddo C---------------------------------------------------------------------- C-------------------- Corrections on ADC-data ------------------------- C--------------------- zenith angle theta --------------------------- C---------------------------------------------------------------------- C if we have a good track use tracking information dx=0. dy=0. dr=0. theta13 = 0. if (xout(1).lt.100.) then dx = xout(1)-xout(3) dy = yout(1)-yout(3) dr = sqrt(dx*dx+dy*dy) theta13 = atan(dr/tofarm13) else IF ((tof12_i.GT.none_find).AND.(tof32_i.GT.none_find)) & dx = xtofpos(1) - xtofpos(3) IF ((tof11_i.GT.none_find).AND.(tof31_i.GT.none_find)) & dy = ytofpos(1) - ytofpos(3) dr = sqrt(dx*dx+dy*dy) theta13 = atan(dr/tofarm13) endif C---------------------------------------------------------------------- C------------------ angle and ADC(x) correction C---------------------------------------------------------------------- C----------------------------- S1 -------------------------------- yhelp=1000. if (yout(1).lt.100.) then yhelp=yout(1) else yhelp=ytofpos(1) endif IF (tof11_i.GT.none_find.AND.yhelp.lt.100) THEN i = tof11_i xdummy=tof11(left,i,iadc) tof11(left,i,iadc) = tof11(left,i,iadc)*cos(theta13) if (tof11(left,i,iadc).lt.1000) then xkorr=adcx11(left,i,1)*exp(-yhelp/adcx11(left,i,2)) xkorr0=adcx11(left,i,1) adc_c(ch11a(i),hb11a(i))=tof11(left,i,iadc)/xkorr endif tof11(right,i,iadc) = tof11(right,i,iadc)*cos(theta13) if (tof11(right,i,iadc).lt.1000) then xkorr=adcx11(right,i,1)*exp(yhelp/adcx11(right,i,2)) xkorr0=adcx11(right,i,1) adc_c(ch11b(i),hb11b(i))=tof11(right,i,iadc)/xkorr endif ENDIF xhelp=1000. if (xout(1).lt.100.) then xhelp=xout(1) else xhelp=xtofpos(1) endif IF (tof12_i.GT.none_find.AND.xhelp.lt.100) THEN i = tof12_i tof12(left,i,iadc) = tof12(left,i,iadc)*cos(theta13) if (tof12(left,i,iadc).lt.1000) then xkorr=adcx12(left,i,1)*exp(-xhelp/adcx12(left,i,2)) xkorr0=adcx12(left,i,1) adc_c(ch12a(i),hb12a(i))=tof12(left,i,iadc)/xkorr endif tof12(right,i,iadc) = tof12(right,i,iadc)*cos(theta13) if (tof12(right,i,iadc).lt.1000) then xkorr=adcx12(right,i,1)*exp(xhelp/adcx12(right,i,2)) xkorr0=adcx12(right,i,1) adc_c(ch12b(i),hb12b(i))=tof12(right,i,iadc)/xkorr endif ENDIF C----------------------------- S2 -------------------------------- xhelp=1000. if (xout(2).lt.100.) then xhelp=xout(2) else xhelp=xtofpos(2) endif IF (tof21_i.GT.none_find.AND.xhelp.lt.100) THEN i = tof21_i tof21(left,i,iadc) = tof21(left,i,iadc)*cos(theta13) if (tof21(left,i,iadc).lt.1000) then xkorr=adcx21(left,i,1)*exp(-xhelp/adcx21(left,i,2)) xkorr0=adcx21(left,i,1) adc_c(ch21a(i),hb21a(i))=tof21(left,i,iadc)/xkorr endif tof21(right,i,iadc) = tof21(right,i,iadc)*cos(theta13) if (tof21(right,i,iadc).lt.1000) then xkorr=adcx21(right,i,1)*exp(xhelp/adcx21(right,i,2)) xkorr0=adcx21(right,i,1) adc_c(ch21b(i),hb21b(i))=tof21(right,i,iadc)/xkorr endif ENDIF yhelp=1000. if (yout(2).lt.100.) then yhelp=yout(2) else yhelp=ytofpos(2) endif IF (tof22_i.GT.none_find.AND.yhelp.lt.100) THEN i = tof22_i tof22(left,i,iadc) = tof22(left,i,iadc)*cos(theta13) if (tof22(left,i,iadc).lt.1000) then xkorr=adcx22(left,i,1)*exp(-yhelp/adcx22(left,i,2)) xkorr0=adcx22(left,i,1) adc_c(ch22a(i),hb22a(i))=tof22(left,i,iadc)/xkorr endif tof22(right,i,iadc) = tof22(right,i,iadc)*cos(theta13) if (tof22(right,i,iadc).lt.1000) then xkorr=adcx22(right,i,1)*exp(yhelp/adcx22(right,i,2)) xkorr0=adcx22(right,i,1) adc_c(ch22b(i),hb22b(i))=tof22(right,i,iadc)/xkorr endif ENDIF C----------------------------- S3 -------------------------------- yhelp=1000. if (yout(3).lt.100.) then yhelp=yout(3) else yhelp=ytofpos(3) endif IF (tof31_i.GT.none_find.AND.yhelp.lt.100) THEN i = tof31_i tof31(left,i,iadc) = tof31(left,i,iadc)*cos(theta13) if (tof31(left,i,iadc).lt.1000) then xkorr=adcx31(left,i,1)*exp(-yhelp/adcx31(left,i,2)) xkorr0=adcx31(left,i,1) adc_c(ch31a(i),hb31a(i))=tof31(left,i,iadc)/xkorr endif tof31(right,i,iadc) = tof31(right,i,iadc)*cos(theta13) if (tof31(right,i,iadc).lt.1000) then xkorr=adcx31(right,i,1)*exp(yhelp/adcx31(right,i,2)) xkorr0=adcx31(right,i,1) adc_c(ch31b(i),hb31b(i))=tof31(right,i,iadc)/xkorr endif ENDIF xhelp=1000. if (xout(3).lt.100.) then xhelp=xout(3) else xhelp=xtofpos(3) endif IF (tof32_i.GT.none_find.AND.xhelp.lt.100) THEN i = tof32_i tof32(left,i,iadc) = tof32(left,i,iadc)*cos(theta13) if (tof32(left,i,iadc).lt.1000) then xkorr=adcx32(left,i,1)*exp(-xhelp/adcx32(left,i,2)) xkorr0=adcx32(left,i,1) adc_c(ch32a(i),hb32a(i))=tof32(left,i,iadc)/xkorr endif tof32(right,i,iadc) = tof32(right,i,iadc)*cos(theta13) if (tof32(right,i,iadc).lt.1000) then xkorr=adcx32(right,i,1)*exp(xhelp/adcx32(right,i,2)) xkorr0=adcx32(right,i,1) adc_c(ch32b(i),hb32b(i))=tof32(right,i,iadc)/xkorr endif ENDIF C----------------------------------------------------------------------- C---------------------- calculate Beta ------------------------------ C----------------------------------------------------------------------- C------------------- difference of sums --------------------------- C C DS = (t1+t2) - t3+t4) C DS = c1 + c2/beta*cos(theta) C c2 = 2d/c gives c2 = 2d/(c*TDCresolution) TDC=50ps/channel C => c2_23 = 60 for 0.45 m c2_13 = 109 for 0.81 m C S11 - S31 IF (tof11_i.GT.none_find.AND.tof31_i.GT.none_find) THEN xhelp1 = tof11(1,tof11_i,itdc)+tof11(2,tof11_i,itdc) xhelp2 = tof31(1,tof31_i,itdc)+tof31(2,tof31_i,itdc) ds = xhelp1-xhelp2 ihelp=(tof11_i-1)*3+tof31_i c1 = k1_S11S31(ihelp) beta_a(1) = c2_13/(cos(theta13)*(ds-c1)) ENDIF C S12 - S32 IF (tof12_i.GT.none_find.AND.tof32_i.GT.none_find) THEN xhelp1 = tof12(1,tof12_i,itdc)+tof12(2,tof12_i,itdc) xhelp2 = tof32(1,tof32_i,itdc)+tof32(2,tof32_i,itdc) ds = xhelp1-xhelp2 ihelp=(tof12_i-1)*3+tof32_i c1 = k1_S12S32(ihelp) beta_a(2) = c2_13/(cos(theta13)*(ds-c1)) ENDIF C S21 - S31 IF (tof21_i.GT.none_find.AND.tof31_i.GT.none_find) THEN xhelp1 = tof21(1,tof21_i,itdc)+tof21(2,tof21_i,itdc) xhelp2 = tof31(1,tof31_i,itdc)+tof31(2,tof31_i,itdc) ds = xhelp1-xhelp2 ihelp=(tof21_i-1)*3+tof31_i c1 = k1_S21S31(ihelp) beta_a(3) = c2_23/(cos(theta13)*(ds-c1)) ENDIF C S22 - S32 IF (tof22_i.GT.none_find.AND.tof32_i.GT.none_find) THEN xhelp1 = tof22(1,tof22_i,itdc)+tof22(2,tof22_i,itdc) xhelp2 = tof32(1,tof32_i,itdc)+tof32(2,tof32_i,itdc) ds = xhelp1-xhelp2 ihelp=(tof22_i-1)*3+tof32_i c1 = k1_S22S32(ihelp) beta_a(4) = c2_23/(cos(theta13)*(ds-c1)) ENDIF C------- icount=0 sw=0. sxw=0. beta_mean=100. do i=1,4 if ((beta_a(i).gt.0.4).and.(beta_a(i).lt.1.5)) then icount= icount+1 if (i.le.2) w_i=1./(0.13**2.) if (i.ge.3) w_i=1./(0.16**2.) sxw=sxw + beta_a(i)*w_i sw =sw + w_i endif enddo if (icount.eq.4) beta_mean=sxw/sw beta_a(5) = beta_mean c ERROR MESSAGES 100 continue * RETURN END