--- DarthVader/ToFLevel2/src/tofl2com.for 2006/08/10 06:32:04 1.3 +++ DarthVader/ToFLevel2/src/tofl2com.for 2007/01/22 10:45:25 1.4 @@ -1,4 +1,19 @@ -***************************************************************************** +****************************************************************************** +* +* 08-12-06 WM: adc_c-bug : The raw ADc value was multiplied with cos(theta) +* and AFTER that there was an if statement "if tof32(right,i,iadc) < 4095" +* +* jan-07 GF: ADCflags(4,12) inserted to flag artificial ADC values +* jan-07 WM: artificial ADC values created using attenuation calibration +* jan-07 WM: modified xtofpos flag "101". xtofpos must be inside physical +* dimension of the paddle +/- 10 cm +* jan-07 WM: if xtofpos=101 then this paddle is not used for beta +* calculation +* jan-07 WM: the definition for a "hit" is changed: Now we must have a +* valid TDC signal on both sides +* jan-07 WM: flag for PMTs #10 and #35 added, TDC=819 due to bit-shift +****************************************************************************** + INTEGER FUNCTION TOFL2COM() c IMPLICIT NONE @@ -17,13 +32,16 @@ REAL xhelp_a,xhelp_t REAL dx,dy,dr,ds - REAL yhelp,xdummy,xkorr0,xhelp,xhelp1,xhelp2 + REAL yhelp,xhelp,xhelp1,xhelp2 REAL c1,c2,sw,sxw,w_i INTEGER icount +c REAL xdummy + INTEGER tof11_j,tof21_j,tof31_j INTEGER tof12_j,tof22_j,tof32_j + REAL beta_mean @@ -35,7 +53,7 @@ INTEGER tof31_event(2,3),tof32_event(2,3) - REAL theta12,theta13,theta23 + REAL theta13 C-- DATA ZTOF/53.74,53.04,23.94,23.44,-23.49,-24.34/ !Sergio 9.05.2006 REAL tofarm12 PARAMETER (tofarm12 = 29.70) ! from 53.39 to 23.69 @@ -43,7 +61,8 @@ PARAMETER (tofarm23 = 47.61) ! from 23.69 to -23.92 REAL tofarm13 PARAMETER (tofarm13 = 77.31) ! from 53.39 to -23.92 - + + REAL hepratio INTEGER ihelp REAL xkorr @@ -63,6 +82,8 @@ * amplitude has to be 'secure' higher than pedestal for an adc event secure = 2. +C ratio between helium and proton ca. 4 + hepratio = 4.5 ! offset = 1 slope = 2 left = 1 @@ -99,6 +120,20 @@ enddo +c gf adc falg: + do i=1,4 + do j=1,12 + adcflagtof(i,j) = 0 + enddo + enddo + +c gf tdc falg: + do i=1,4 + do j=1,12 + tdcflagtof(i,j) = 0 + enddo + enddo + c the calibration files are read in the main program from xxx_tofcalib.rz @@ -195,8 +230,67 @@ if (abs(tof32(2,i,iadc)).gt.10000.) tof32(2,i,iadc)= 10000. ENDDO +C---------------------------------------------------------------------- +C------------------ set ADC & TDC flag = 0 ------------------------ +C---------------------------------------------------------------------- + + do j=1,8 + if (adc(ch11a(j),hb11a(j)).LT.4096)adcflagtof(ch11a(j),hb11a(j))=0 + if (adc(ch11b(j),hb11b(j)).LT.4096)adcflagtof(ch11b(j),hb11b(j))=0 + if (tdc(ch11a(j),hb11a(j)).LT.4096)tdcflagtof(ch11a(j),hb11a(j))=0 + if (tdc(ch11b(j),hb11b(j)).LT.4096)tdcflagtof(ch11b(j),hb11b(j))=0 + enddo + do j=1,6 + if (adc(ch12a(j),hb12a(j)).LT.4096)adcflagtof(ch12a(j),hb12a(j))=0 + if (adc(ch12b(j),hb12b(j)).LT.4096)adcflagtof(ch12b(j),hb12b(j))=0 + if (tdc(ch12a(j),hb12a(j)).LT.4096)tdcflagtof(ch12a(j),hb12a(j))=0 + if (tdc(ch12b(j),hb12b(j)).LT.4096)tdcflagtof(ch12b(j),hb12b(j))=0 + enddo + do j=1,2 + if (adc(ch21a(j),hb21a(j)).LT.4096)adcflagtof(ch21a(j),hb21a(j))=0 + if (adc(ch21b(j),hb21b(j)).LT.4096)adcflagtof(ch21b(j),hb21b(j))=0 + if (tdc(ch21a(j),hb21a(j)).LT.4096)tdcflagtof(ch21a(j),hb21a(j))=0 + if (tdc(ch21b(j),hb21b(j)).LT.4096)tdcflagtof(ch21b(j),hb21b(j))=0 + enddo + do j=1,2 + if (adc(ch22a(j),hb22a(j)).LT.4096)adcflagtof(ch22a(j),hb22a(j))=0 + if (adc(ch22b(j),hb22b(j)).LT.4096)adcflagtof(ch22b(j),hb22b(j))=0 + if (tdc(ch22a(j),hb22a(j)).LT.4096)tdcflagtof(ch22a(j),hb22a(j))=0 + if (tdc(ch22b(j),hb22b(j)).LT.4096)tdcflagtof(ch22b(j),hb22b(j))=0 + enddo + do j=1,3 + if (adc(ch31a(j),hb31a(j)).LT.4096)adcflagtof(ch31a(j),hb31a(j))=0 + if (adc(ch31b(j),hb31b(j)).LT.4096)adcflagtof(ch31b(j),hb31b(j))=0 + if (tdc(ch31a(j),hb31a(j)).LT.4096)tdcflagtof(ch31a(j),hb31a(j))=0 + if (tdc(ch31b(j),hb31b(j)).LT.4096)tdcflagtof(ch31b(j),hb31b(j))=0 + enddo + do j=1,3 + if (adc(ch32a(j),hb32a(j)).LT.4096)adcflagtof(ch32a(j),hb32a(j))=0 + if (adc(ch32b(j),hb32b(j)).LT.4096)adcflagtof(ch32b(j),hb32b(j))=0 + if (tdc(ch32a(j),hb32a(j)).LT.4096)tdcflagtof(ch32a(j),hb32a(j))=0 + if (tdc(ch32b(j),hb32b(j)).LT.4096)tdcflagtof(ch32b(j),hb32b(j))=0 + enddo + C---------------------------------------------------------------- -C------------Check Paddles for hits ----------------------- +C---------- Check PMTs 10 and 35 for strange TDC values---------- +C---------------------------------------------------------------- + +C---- S116A TDC=819 + if (tof11(1,6,1).EQ.819) then + tof11(1,6,1) = 4095 + tdcflagtof(ch11a(6),hb11a(6))=2 + endif + +C---- S222B TDC=819 + if (tof22(2,2,1).EQ.819) then + tof22(2,2,1) = 4095 + tdcflagtof(ch22b(2),hb22b(2))=2 + endif + + +C---------------------------------------------------------------- +C------------ Check Paddles for hits ----------------------- +C------ a "hit" means TDC values<4095 on both sides ------------ C---------------------------------------------------------------- C upper tof S11 @@ -206,9 +300,6 @@ 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 @@ -239,9 +330,6 @@ 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 @@ -272,9 +360,6 @@ 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 @@ -304,9 +389,6 @@ 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 @@ -337,9 +419,6 @@ 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 @@ -369,9 +448,6 @@ 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 @@ -414,6 +490,261 @@ tof_j_flag(5)=tof31_j tof_j_flag(6)=tof32_j + +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) + 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) + endif + + +c do i=1,3 +c if (abs(xtofpos(i)).gt.100.) then +c xtofpos(i)=101. +c endif +c if (abs(ytofpos(i)).gt.100.) then +c ytofpos(i)=101. +c endif +c enddo + +C-- restrict TDC measurements to physical paddle dimensions +/- 10 cm +C-- this cut is now stronger than in the old versions + + if (abs(xtofpos(1)).gt.31.) xtofpos(1)=101. + if (abs(xtofpos(2)).gt.19.) xtofpos(2)=101. + if (abs(xtofpos(3)).gt.19.) xtofpos(3)=101. + + if (abs(ytofpos(1)).gt.26.) ytofpos(1)=101. + if (abs(ytofpos(2)).gt.18.) ytofpos(2)=101. + if (abs(ytofpos(3)).gt.18.) ytofpos(3)=101. + + +C---------------------------------------------------------------------- +C--------------------- zenith angle theta --------------------------- +C---------------------------------------------------------------------- + + dx=0. + dy=0. + dr=0. + theta13 = 0. + + 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) + +C------------------------------------------------------------------ +c dx=0. +c dy=0. +c dr=0. +c theta12 = 0. +c +c IF ((tof12_i.GT.none_find).AND.(tof21_i.GT.none_find)) +c & dx = xtofpos(1) - xtofpos(2) +c IF ((tof11_i.GT.none_find).AND.(tof22_i.GT.none_find)) +c & dy = ytofpos(1) - ytofpos(2) +c dr = sqrt(dx*dx+dy*dy) +c theta12 = atan(dr/tofarm12) +c +c dx=0. +c dy=0. +c dr=0. +c theta23 = 0. +c +c IF ((tof21_i.GT.none_find).AND.(tof32_i.GT.none_find)) +c & dx = xtofpos(2) - xtofpos(3) +c IF ((tof22_i.GT.none_find).AND.(tof31_i.GT.none_find)) +c & dy = ytofpos(2) - ytofpos(3) +c dr = sqrt(dx*dx+dy*dy) +c theta23 = atan(dr/tofarm23) +c +C--------------------------------------------------------------------- + + +C-------------------------------------------------------------------- +C---- if TDCleft.and.TDCright and NO ADC insert artificial ADC +C---- values +C-------------------------------------------------------------------- +c middle y (or x) position of the upper and middle ToF-Paddle +c DATA tof11_x/ -17.85,-12.75,-7.65,-2.55,2.55,7.65,12.75,17.85/ +c DATA tof12_y/ -13.75,-8.25,-2.75,2.75,8.25,13.75/ +c DATA tof21_y/ 3.75,-3.75/ ! paddles in different order +c DATA tof22_x/ -4.5,4.5/ +c DATA tof31_x/ -6.0,0.,6.0/ +c DATA tof32_y/ -5.0,0.0,5.0/ + + +C---------------------------- S1 ------------------------------------- + + yhelp=0. + if (tof12_i.GT.none_find) yhelp=tof12_y(tof12_i) + if (ytofpos(1).lt.100) yhelp=ytofpos(1) + + IF (tof11_i.GT.none_find.AND.abs(yhelp).lt.100) THEN + i = tof11_i + if (tof11(left,i,iadc).eq.4095) then + xkorr=adcx11(left,i,1)*exp(-yhelp/adcx11(left,i,2)) + xkorr=xkorr/hepratio + tof11(left,i,iadc)=xkorr/cos(theta13) +c write(*,*) 'tofl2 left ',i, tof11(left,i,iadc) + adcflagtof(ch11a(i),hb11a(i)) = 1 + endif + if (tof11(right,i,iadc).eq.4095) then + xkorr=adcx11(right,i,1)*exp(yhelp/adcx11(right,i,2)) + xkorr=xkorr/hepratio + tof11(right,i,iadc)=xkorr/cos(theta13) +c write(*,*) 'tofl2 right ',i, tof11(right,i,iadc) + adcflagtof(ch11b(i),hb11b(i)) = 1 + endif + ENDIF + + xhelp=0. + if (tof11_i.GT.none_find) xhelp=tof11_x(tof11_i) + if (xtofpos(1).lt.100) xhelp=xtofpos(1) + + IF (tof12_i.GT.none_find.AND.abs(xhelp).lt.100) THEN + i = tof12_i + if (tof12(left,i,iadc).eq.4095) then + xkorr=adcx12(left,i,1)*exp(-xhelp/adcx12(left,i,2)) + xkorr=xkorr/hepratio + tof12(left,i,iadc) = xkorr/cos(theta13) + adcflagtof(ch12a(i),hb12a(i)) = 1 + endif + if (tof12(right,i,iadc).eq.4095) then + xkorr=adcx12(right,i,1)*exp(xhelp/adcx12(right,i,2)) + xkorr=xkorr/hepratio + tof12(right,i,iadc) = xkorr/cos(theta13) + adcflagtof(ch12b(i),hb12b(i)) = 1 + endif + ENDIF + +C-----------------------------S2 -------------------------------- + + xhelp=0. + if (tof22_i.GT.none_find) xhelp=tof22_x(tof22_i) + if (xtofpos(2).lt.100) xhelp=xtofpos(2) + + IF (tof21_i.GT.none_find.AND.abs(xhelp).lt.100) THEN + i = tof21_i + if (tof21(left,i,iadc).eq.4095) then + xkorr=adcx21(left,i,1)*exp(-xhelp/adcx21(left,i,2)) + xkorr=xkorr/hepratio + tof21(left,i,iadc) = xkorr/cos(theta13) + adcflagtof(ch21a(i),hb21a(i)) = 1 + endif + if (tof21(right,i,iadc).eq.4095) then + xkorr=adcx21(right,i,1)*exp(xhelp/adcx21(right,i,2)) + xkorr=xkorr/hepratio + tof21(right,i,iadc) = xkorr/cos(theta13) + adcflagtof(ch21b(i),hb21b(i)) = 1 + endif + ENDIF + + + yhelp=0. + if (tof21_i.GT.none_find) yhelp=tof21_y(tof21_i) + if (ytofpos(2).lt.100) yhelp=ytofpos(2) + + IF (tof22_i.GT.none_find.AND.abs(yhelp).lt.100) THEN + i = tof22_i + if (tof22(left,i,iadc).eq.4095) then + xkorr=adcx22(left,i,1)*exp(-yhelp/adcx22(left,i,2)) + xkorr=xkorr/hepratio + tof22(left,i,iadc) = xkorr/cos(theta13) + adcflagtof(ch22a(i),hb22a(i)) = 1 + endif + if (tof22(right,i,iadc).eq.4095) then + xkorr=adcx22(right,i,1)*exp(yhelp/adcx22(right,i,2)) + xkorr=xkorr/hepratio + tof22(right,i,iadc) = xkorr/cos(theta13) + adcflagtof(ch22b(i),hb22b(i)) = 1 + endif + ENDIF + +C-----------------------------S3 -------------------------------- + + yhelp=0. + if (tof32_i.GT.none_find) yhelp=tof32_y(tof32_i) + if (ytofpos(3).lt.100) yhelp=ytofpos(3) + + IF (tof31_i.GT.none_find.AND.abs(yhelp).lt.100) THEN + i = tof31_i + if (tof31(left,i,iadc).eq.4095) then + xkorr=adcx31(left,i,1)*exp(-yhelp/adcx31(left,i,2)) + xkorr=xkorr/hepratio + tof31(left,i,iadc) = xkorr/cos(theta13) + adcflagtof(ch31a(i),hb31a(i)) = 1 + endif + if (tof31(right,i,iadc).eq.4095) then + xkorr=adcx31(right,i,1)*exp(yhelp/adcx31(right,i,2)) + xkorr=xkorr/hepratio + tof31(right,i,iadc) = xkorr/cos(theta13) + adcflagtof(ch31b(i),hb31b(i)) = 1 + endif + ENDIF + + xhelp=0. + if (tof31_i.GT.none_find) xhelp=tof31_x(tof31_i) + if (xtofpos(3).lt.100) xhelp=xtofpos(3) + + IF (tof32_i.GT.none_find.AND.abs(xhelp).lt.100) THEN + i = tof32_i + if (tof32(left,i,iadc).eq.4095) then + xkorr=adcx32(left,i,1)*exp(-xhelp/adcx32(left,i,2)) + xkorr=xkorr/hepratio + tof32(left,i,iadc) = xkorr/cos(theta13) + adcflagtof(ch32a(i),hb32a(i)) = 1 + endif + if (tof32(right,i,iadc).eq.4095) then + xkorr=adcx32(right,i,1)*exp(xhelp/adcx32(right,i,2)) + xkorr=xkorr/hepratio + tof32(right,i,iadc) = xkorr/cos(theta13) + adcflagtof(ch32b(i),hb32b(i)) = 1 + endif + ENDIF + C-------------------------------------------------------------------- C--------------------Time walk correction ------------------------- @@ -422,12 +753,12 @@ DO i=1,8 xhelp_a = tof11(left,i,iadc) xhelp_t = tof11(left,i,itdc) - if(xhelp_a>0) xhelp = tw11(left,i)/sqrt(xhelp_a) + if(xhelp_a<4095) xhelp = tw11(left,i)/sqrt(xhelp_a) tof11(left,i,itdc) = xhelp_t + xhelp tdc_c(ch11a(i),hb11a(i))=tof11(left,i,itdc) xhelp_a = tof11(right,i,iadc) xhelp_t = tof11(right,i,itdc) - if(xhelp_a>0) xhelp = tw11(right,i)/sqrt(xhelp_a) + if(xhelp_a<4095) xhelp = tw11(right,i)/sqrt(xhelp_a) tof11(right,i,itdc) = xhelp_t + xhelp tdc_c(ch11b(i),hb11b(i))=tof11(right,i,itdc) ENDDO @@ -435,12 +766,12 @@ DO i=1,6 xhelp_a = tof12(left,i,iadc) xhelp_t = tof12(left,i,itdc) - if(xhelp_a>0) xhelp = tw12(left,i)/sqrt(xhelp_a) + if(xhelp_a<4095) xhelp = tw12(left,i)/sqrt(xhelp_a) tof12(left,i,itdc) = xhelp_t + xhelp tdc_c(ch12a(i),hb12a(i))=tof12(left,i,itdc) xhelp_a = tof12(right,i,iadc) xhelp_t = tof12(right,i,itdc) - if(xhelp_a>0) xhelp = tw12(right,i)/sqrt(xhelp_a) + if(xhelp_a<4095) xhelp = tw12(right,i)/sqrt(xhelp_a) tof12(right,i,itdc) = xhelp_t + xhelp tdc_c(ch12b(i),hb12b(i))=tof12(right,i,itdc) ENDDO @@ -448,12 +779,12 @@ DO i=1,2 xhelp_a = tof21(left,i,iadc) xhelp_t = tof21(left,i,itdc) - if(xhelp_a>0) xhelp = tw21(left,i)/sqrt(xhelp_a) + if(xhelp_a<4095) xhelp = tw21(left,i)/sqrt(xhelp_a) tof21(left,i,itdc) = xhelp_t + xhelp tdc_c(ch21a(i),hb21a(i))=tof21(left,i,itdc) xhelp_a = tof21(right,i,iadc) xhelp_t = tof21(right,i,itdc) - if(xhelp_a>0) xhelp = tw21(right,i)/sqrt(xhelp_a) + if(xhelp_a<4095) xhelp = tw21(right,i)/sqrt(xhelp_a) tof21(right,i,itdc) = xhelp_t + xhelp tdc_c(ch21b(i),hb21b(i))=tof21(right,i,itdc) ENDDO @@ -461,12 +792,12 @@ DO i=1,2 xhelp_a = tof22(left,i,iadc) xhelp_t = tof22(left,i,itdc) - if(xhelp_a>0) xhelp = tw22(left,i)/sqrt(xhelp_a) + if(xhelp_a<4095) xhelp = tw22(left,i)/sqrt(xhelp_a) tof22(left,i,itdc) = xhelp_t + xhelp tdc_c(ch22a(i),hb22a(i))=tof22(left,i,itdc) xhelp_a = tof22(right,i,iadc) xhelp_t = tof22(right,i,itdc) - if(xhelp_a>0) xhelp = tw22(right,i)/sqrt(xhelp_a) + if(xhelp_a<4095) xhelp = tw22(right,i)/sqrt(xhelp_a) tof22(right,i,itdc) = xhelp_t + xhelp tdc_c(ch22b(i),hb22b(i))=tof22(right,i,itdc) ENDDO @@ -475,12 +806,12 @@ DO i=1,3 xhelp_a = tof31(left,i,iadc) xhelp_t = tof31(left,i,itdc) - if(xhelp_a>0) xhelp = tw31(left,i)/sqrt(xhelp_a) + if(xhelp_a<4095) xhelp = tw31(left,i)/sqrt(xhelp_a) tof31(left,i,itdc) = xhelp_t + xhelp tdc_c(ch31a(i),hb31a(i))=tof31(left,i,itdc) xhelp_a = tof31(right,i,iadc) xhelp_t = tof31(right,i,itdc) - if(xhelp_a>0) xhelp = tw31(right,i)/sqrt(xhelp_a) + if(xhelp_a<4095) xhelp = tw31(right,i)/sqrt(xhelp_a) tof31(right,i,itdc) = xhelp_t + xhelp tdc_c(ch31b(i),hb31b(i))=tof31(right,i,itdc) ENDDO @@ -488,123 +819,24 @@ DO i=1,3 xhelp_a = tof32(left,i,iadc) xhelp_t = tof32(left,i,itdc) - if(xhelp_a>0) xhelp = tw32(left,i)/sqrt(xhelp_a) + if(xhelp_a<4095) xhelp = tw32(left,i)/sqrt(xhelp_a) tof32(left,i,itdc) = xhelp_t + xhelp tdc_c(ch32a(i),hb32a(i))=tof32(left,i,itdc) xhelp_a = tof32(right,i,iadc) xhelp_t = tof32(right,i,itdc) - if(xhelp_a>0) xhelp = tw32(right,i)/sqrt(xhelp_a) + if(xhelp_a<4095) xhelp = tw32(right,i)/sqrt(xhelp_a) tof32(right,i,itdc) = xhelp_t + xhelp tdc_c(ch32b(i),hb32b(i))=tof32(right,i,itdc) ENDDO -C---- - -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) - 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) - 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---------------------------------------------------------------------- - - dx=0. - dy=0. - dr=0. - theta13 = 0. - - 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) - - dx=0. - dy=0. - dr=0. - theta12 = 0. - - IF ((tof12_i.GT.none_find).AND.(tof21_i.GT.none_find)) - & dx = xtofpos(1) - xtofpos(2) - IF ((tof11_i.GT.none_find).AND.(tof22_i.GT.none_find)) - & dy = ytofpos(1) - ytofpos(2) - dr = sqrt(dx*dx+dy*dy) - theta12 = atan(dr/tofarm12) - - dx=0. - dy=0. - dr=0. - theta23 = 0. - - IF ((tof21_i.GT.none_find).AND.(tof32_i.GT.none_find)) - & dx = xtofpos(2) - xtofpos(3) - IF ((tof22_i.GT.none_find).AND.(tof31_i.GT.none_find)) - & dy = ytofpos(2) - ytofpos(3) - dr = sqrt(dx*dx+dy*dy) - theta23 = atan(dr/tofarm23) - - -C---------------------------------------------------------------------- C------------------angle and ADC(x) correction C---------------------------------------------------------------------- C-----------------------------S1 -------------------------------- c middle y (or x) position of the upper and middle ToF-Paddle c DATA tof11_x/ -17.85,-12.75,-7.65,-2.55,2.55,7.65,12.75,17.85/ c DATA tof12_y/ -13.75,-8.25,-2.75,2.75,8.25,13.75/ -c DATA tof21_y/ -3.75,3.75/ +c DATA tof21_y/ 3.75,-3.75/ ! paddles in different order c DATA tof22_x/ -4.5,4.5/ c DATA tof31_x/ -6.0,0.,6.0/ c DATA tof32_y/ -5.0,0.0,5.0/ @@ -616,18 +848,17 @@ IF (tof11_i.GT.none_find.AND.abs(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.4095) then + tof11(left,i,iadc) = tof11(left,i,iadc)*cos(theta13) xkorr=adcx11(left,i,1)*exp(-yhelp/adcx11(left,i,2)) - xkorr0=adcx11(left,i,1) + xkorr=xkorr/hepratio adctof_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.4095) then + tof11(right,i,iadc) = tof11(right,i,iadc)*cos(theta13) xkorr=adcx11(right,i,1)*exp(yhelp/adcx11(right,i,2)) - xkorr0=adcx11(right,i,1) + xkorr=xkorr/hepratio adctof_c(ch11b(i),hb11b(i))=tof11(right,i,iadc)/xkorr endif ENDIF @@ -639,17 +870,17 @@ IF (tof12_i.GT.none_find.AND.abs(xhelp).lt.100) THEN i = tof12_i - tof12(left,i,iadc) = tof12(left,i,iadc)*cos(theta13) if (tof12(left,i,iadc).lt.4095) then + tof12(left,i,iadc) = tof12(left,i,iadc)*cos(theta13) xkorr=adcx12(left,i,1)*exp(-xhelp/adcx12(left,i,2)) - xkorr0=adcx12(left,i,1) + xkorr=xkorr/hepratio adctof_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.4095) then + tof12(right,i,iadc) = tof12(right,i,iadc)*cos(theta13) xkorr=adcx12(right,i,1)*exp(xhelp/adcx12(right,i,2)) - xkorr0=adcx12(right,i,1) + xkorr=xkorr/hepratio adctof_c(ch12b(i),hb12b(i))=tof12(right,i,iadc)/xkorr endif ENDIF @@ -663,17 +894,17 @@ IF (tof21_i.GT.none_find.AND.abs(xhelp).lt.100) THEN i = tof21_i - tof21(left,i,iadc) = tof21(left,i,iadc)*cos(theta13) if (tof21(left,i,iadc).lt.4095) then + tof21(left,i,iadc) = tof21(left,i,iadc)*cos(theta13) xkorr=adcx21(left,i,1)*exp(-xhelp/adcx21(left,i,2)) - xkorr0=adcx21(left,i,1) + xkorr=xkorr/hepratio adctof_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.4095) then + tof21(right,i,iadc) = tof21(right,i,iadc)*cos(theta13) xkorr=adcx21(right,i,1)*exp(xhelp/adcx21(right,i,2)) - xkorr0=adcx21(right,i,1) + xkorr=xkorr/hepratio adctof_c(ch21b(i),hb21b(i))=tof21(right,i,iadc)/xkorr endif ENDIF @@ -686,17 +917,17 @@ IF (tof22_i.GT.none_find.AND.abs(yhelp).lt.100) THEN i = tof22_i - tof22(left,i,iadc) = tof22(left,i,iadc)*cos(theta13) if (tof22(left,i,iadc).lt.4095) then + tof22(left,i,iadc) = tof22(left,i,iadc)*cos(theta13) xkorr=adcx22(left,i,1)*exp(-yhelp/adcx22(left,i,2)) - xkorr0=adcx22(left,i,1) + xkorr=xkorr/hepratio adctof_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.4095) then + tof22(right,i,iadc) = tof22(right,i,iadc)*cos(theta13) xkorr=adcx22(right,i,1)*exp(yhelp/adcx22(right,i,2)) - xkorr0=adcx22(right,i,1) + xkorr=xkorr/hepratio adctof_c(ch22b(i),hb22b(i))=tof22(right,i,iadc)/xkorr endif ENDIF @@ -710,17 +941,17 @@ IF (tof31_i.GT.none_find.AND.abs(yhelp).lt.100) THEN i = tof31_i - tof31(left,i,iadc) = tof31(left,i,iadc)*cos(theta13) if (tof31(left,i,iadc).lt.4095) then + tof31(left,i,iadc) = tof31(left,i,iadc)*cos(theta13) xkorr=adcx31(left,i,1)*exp(-yhelp/adcx31(left,i,2)) - xkorr0=adcx31(left,i,1) + xkorr=xkorr/hepratio adctof_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.4095) then + tof31(right,i,iadc) = tof31(right,i,iadc)*cos(theta13) xkorr=adcx31(right,i,1)*exp(yhelp/adcx31(right,i,2)) - xkorr0=adcx31(right,i,1) + xkorr=xkorr/hepratio adctof_c(ch31b(i),hb31b(i))=tof31(right,i,iadc)/xkorr endif ENDIF @@ -732,25 +963,26 @@ IF (tof32_i.GT.none_find.AND.abs(xhelp).lt.100) THEN i = tof32_i - tof32(left,i,iadc) = tof32(left,i,iadc)*cos(theta13) if (tof32(left,i,iadc).lt.4095) then + tof32(left,i,iadc) = tof32(left,i,iadc)*cos(theta13) xkorr=adcx32(left,i,1)*exp(-xhelp/adcx32(left,i,2)) - xkorr0=adcx32(left,i,1) + xkorr=xkorr/hepratio adctof_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.4095) then + tof32(right,i,iadc) = tof32(right,i,iadc)*cos(theta13) xkorr=adcx32(right,i,1)*exp(xhelp/adcx32(right,i,2)) - xkorr0=adcx32(right,i,1) + xkorr=xkorr/hepratio adctof_c(ch32b(i),hb32b(i))=tof32(right,i,iadc)/xkorr endif ENDIF -C----------------------------------------------------------------------- + +C-------------------------------------------------------------------- C----------------------calculate Beta ------------------------------ -C----------------------------------------------------------------------- -C-------------------difference of sums --------------------------- +C-------------------------------------------------------------------- +C-------------------difference of sums ----------------------------- C C DS = (t1+t2) - t3+t4) C DS = c1 + c2/beta*cos(theta) @@ -759,7 +991,9 @@ C since TDC resolution varies slightly c2 has to be calibrated C S11 - S31 - IF (tof11_i.GT.none_find.AND.tof31_i.GT.none_find) THEN + + IF ((tof11_i.GT.none_find).AND.(tof31_i.GT.none_find).AND. + & (ytofpos(1).NE.101.).AND.(ytofpos(3).NE.101.)) 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 @@ -785,7 +1019,9 @@ ENDIF C S11 - S32 - IF (tof11_i.GT.none_find.AND.tof32_i.GT.none_find) THEN + + IF ((tof11_i.GT.none_find).AND.(tof32_i.GT.none_find).AND. + & (ytofpos(1).NE.101.).AND.(xtofpos(3).NE.101.)) THEN xhelp1 = tof11(1,tof11_i,itdc)+tof11(2,tof11_i,itdc) xhelp2 = tof32(1,tof32_i,itdc)+tof32(2,tof32_i,itdc) ds = xhelp1-xhelp2 @@ -811,7 +1047,9 @@ ENDIF C S12 - S31 - IF (tof12_i.GT.none_find.AND.tof31_i.GT.none_find) THEN + + IF ((tof12_i.GT.none_find).AND.(tof31_i.GT.none_find).AND. + & (xtofpos(1).NE.101.).AND.(ytofpos(3).NE.101.)) THEN xhelp1 = tof12(1,tof12_i,itdc)+tof12(2,tof12_i,itdc) xhelp2 = tof31(1,tof31_i,itdc)+tof31(2,tof31_i,itdc) ds = xhelp1-xhelp2 @@ -837,7 +1075,9 @@ ENDIF C S12 - S32 - IF (tof12_i.GT.none_find.AND.tof32_i.GT.none_find) THEN + + IF ((tof12_i.GT.none_find).AND.(tof32_i.GT.none_find).AND. + & (xtofpos(1).NE.101.).AND.(xtofpos(3).NE.101.)) 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 @@ -863,14 +1103,16 @@ ENDIF C S21 - S31 - IF (tof21_i.GT.none_find.AND.tof31_i.GT.none_find) THEN + + IF ((tof21_i.GT.none_find).AND.(tof31_i.GT.none_find).AND. + & (xtofpos(2).NE.101.).AND.(ytofpos(3).NE.101.)) 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 = k_S21S31(1,ihelp) c2 = k_S21S31(2,ihelp) - betatof_a(5) = c2/(cos(theta23)*(ds-c1)) + betatof_a(5) = c2/(cos(theta13)*(ds-c1)) C------- ToF Mask - S21 - S31 @@ -889,14 +1131,16 @@ ENDIF C S21 - S32 - IF (tof21_i.GT.none_find.AND.tof32_i.GT.none_find) THEN + + IF ((tof21_i.GT.none_find).AND.(tof32_i.GT.none_find).AND. + & (xtofpos(2).NE.101.).AND.(xtofpos(3).NE.101.)) THEN xhelp1 = tof21(1,tof21_i,itdc)+tof21(2,tof21_i,itdc) xhelp2 = tof32(1,tof32_i,itdc)+tof32(2,tof32_i,itdc) ds = xhelp1-xhelp2 ihelp=(tof21_i-1)*3+tof32_i c1 = k_S21S32(1,ihelp) c2 = k_S21S32(2,ihelp) - betatof_a(6) = c2/(cos(theta23)*(ds-c1)) + betatof_a(6) = c2/(cos(theta13)*(ds-c1)) C------- ToF Mask - S21 - S32 @@ -915,7 +1159,9 @@ ENDIF C S22 - S31 - IF (tof22_i.GT.none_find.AND.tof31_i.GT.none_find) THEN + + IF ((tof22_i.GT.none_find).AND.(tof31_i.GT.none_find).AND. + & (ytofpos(2).NE.101.).AND.(ytofpos(3).NE.101.)) THEN xhelp1 = tof22(1,tof22_i,itdc)+tof22(2,tof22_i,itdc) xhelp2 = tof31(1,tof31_i,itdc)+tof31(2,tof31_i,itdc) ds = xhelp1-xhelp2 @@ -941,7 +1187,9 @@ ENDIF C S22 - S32 - IF (tof22_i.GT.none_find.AND.tof32_i.GT.none_find) THEN + + IF ((tof22_i.GT.none_find).AND.(tof32_i.GT.none_find).AND. + & (ytofpos(2).NE.101.).AND.(xtofpos(3).NE.101.)) 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 @@ -967,7 +1215,9 @@ ENDIF C S11 - S21 - IF (tof11_i.GT.none_find.AND.tof21_i.GT.none_find) THEN + + IF ((tof11_i.GT.none_find).AND.(tof21_i.GT.none_find).AND. + & (ytofpos(1).NE.101.).AND.(xtofpos(2).NE.101.)) THEN xhelp1 = tof11(1,tof11_i,itdc)+tof11(2,tof11_i,itdc) xhelp2 = tof21(1,tof21_i,itdc)+tof21(2,tof21_i,itdc) ds = xhelp1-xhelp2 @@ -993,7 +1243,9 @@ ENDIF C S11 - S22 - IF (tof11_i.GT.none_find.AND.tof22_i.GT.none_find) THEN + + IF ((tof11_i.GT.none_find).AND.(tof22_i.GT.none_find).AND. + & (ytofpos(1).NE.101.).AND.(ytofpos(2).NE.101.)) THEN xhelp1 = tof11(1,tof11_i,itdc)+tof11(2,tof11_i,itdc) xhelp2 = tof22(1,tof22_i,itdc)+tof22(2,tof22_i,itdc) ds = xhelp1-xhelp2 @@ -1019,7 +1271,9 @@ ENDIF C S12 - S21 - IF (tof12_i.GT.none_find.AND.tof21_i.GT.none_find) THEN + + IF ((tof12_i.GT.none_find).AND.(tof21_i.GT.none_find).AND. + & (xtofpos(1).NE.101.).AND.(xtofpos(2).NE.101.)) THEN xhelp1 = tof12(1,tof12_i,itdc)+tof12(2,tof12_i,itdc) xhelp2 = tof21(1,tof21_i,itdc)+tof21(2,tof21_i,itdc) ds = xhelp1-xhelp2 @@ -1045,7 +1299,9 @@ ENDIF C S12 - S22 - IF (tof12_i.GT.none_find.AND.tof22_i.GT.none_find) THEN + + IF ((tof12_i.GT.none_find).AND.(tof22_i.GT.none_find).AND. + & (xtofpos(1).NE.101.).AND.(ytofpos(2).NE.101.)) THEN xhelp1 = tof12(1,tof12_i,itdc)+tof12(2,tof12_i,itdc) xhelp2 = tof22(1,tof22_i,itdc)+tof22(2,tof22_i,itdc) ds = xhelp1-xhelp2 @@ -1091,8 +1347,15 @@ if (icount.gt.0) beta_mean=sxw/sw betatof_a(13) = beta_mean +c write(*,*) xtofpos +c write(*,*) ytofpos +c write(*,*) betatof_a +C write(*,*) adcflagtof + + 100 continue C RETURN END +