***************************************************************************** Subroutine cdfz(iflag) ***************************************************************************** * * This routine produces two Monte Carlo graphs. * id 10 is the normalised cross section in nb * These graph will be * meaningless unless Xsec and Ntot are set before * calling the termination routine. * (Xsec - total cross section returned by MC) * (Ntot - number of events passed to this routine) * * * THE FINAL CROSS SECTION TO BE COMPARED * WITH THE DATA IS HISTOGRAM 5. * * Author : CLAIRE O'DEA * * ***************************************************************************** * * HERA Tuning defined commons IMPLICIT NONE #include "hepevtp.inc" #include "heracmn.inc" #include "hzfunc.inc" DOUBLE PRECISION mtotal,thetaelec,thetapos,rapelec,rappos,Etelec DOUBLE PRECISION Etpos,Etpair,norme(50) INTEGER ielec,ipos,m INTEGER loop1,loop2,loop3 DOUBLE PRECISION Eelec,Pxelec,Pyelec,Pzelec DOUBLE PRECISION Epos,Pxpos,Pypos,Pzpos C --- cuts arrays DOUBLE PRECISION rapcut1(1),rapcut2(2),rapcut3(2),masscut(2) DOUBLE PRECISION Emin1,Emin2,Emin3 C --- private copies of Xsec and Ntot from HERACMN DOUBLE PRECISION mhxsec(2),mhntot(2) INTEGER intiflag,iflag,MAXEV Real pi REAL norm(50),binPt(51),mass(50),error(50) c Storing the data for the values of the bin edge with c values from table 1******* Data binPt/0.5,1,1.5,2,2.5,3,3.5,4,4.5,5,5.5,6,6.5,7,7.5, 1 8,8.5,9,9.5,10,10.5,11,11.5,12,13,14,15,16,17, 2 18,19,20,22,24,26,28,30,34,36,40,44,46,50,60, 3 70,80,90,100,125,150,200/ c write(*,*) Ntot c write(*,*) Xsec c CALL HBOOKB(2,'Normalisation values',50,binPt,0.0) c storing real data for the differential cross section given c in table I ****** Data mass/3.35d0,1.01d1,1.48d1,1.94d1,2.02d1,2 1 .36d1,2.36d1, 1 2.3d1,1.99d1,1.93d1,1.79d1,1.8d1,1.46d1,1.45d1, 2 1.35d1,1.37d1,1.19d1,1.04d1,1.11d1,9.56d0,8.35d0, 3 7.82d0,8.18d0,7.48d0,7.21d0,6.05d0,4.73d0,5.21d0, 4 4.46d0,4.28d0,3.51d0,3.01d0,2.63d0,1.82d0,1.85d0, 5 1.58d0,1.41d0,1.02d0,6.78d-1,6.44d-1,4.34d-1, 6 3.94d-1,2.1d-1,1.07d-1,9.10d-2,4.50d-2,3.51d-2, 7 1.81d-2,7.11d-3,9.74d-4/ c storing real data for the total error ****** Data error/0.54d0,0.10d1,0.12d1,0.14d1,0.14d1,0.15d1, 1 0.14d1,0.14d1,0.13d1,0.12d1,0.12d1,0.12d1,0.10d1, 2 0.10d1,0.10d1,0.10d1,0.09d1,0.09d1,0.09d1, 3 0.82d0,0.76d0,0.74d0,0.76d0,0.72d0,0.53d0, 4 0.47d0,0.41d0,0.44d0,0.40d0,0.39d0,0.35d0, 5 0.33d0,0.22d0,0.18d0,0.18d0,0.17d0,0.16d0, 6 0.10d0,0.79d-1,0.76d-1,0.62d-1,0.59d-1, 7 0.27d-1,0.19d-1,1.75d-2,1.22d-2,1.07d-2, 8 0.48d-2,2.97d-3,7.56d-4/ intiflag=iflag IF (intiflag.eq.1) THEN C *** Initialisation run *** C *** Create directories *** CALL HCDIR('//HISTO',' ') CALL HMDIR('cdfz','S') CALL HCDIR('//PAWC',' ') CALL HMDIR('cdfz','S') c$$$ c open all the hbook's for generating the final histograms for c$$$ the c paper number hep-ex/cdfz CALL HBOOKB(1,'Diff e+e- Pt Cross Section',50 1 ,binPt,0.) CALL HBOOKB(3,'Unnorm. Diff. e+e- Pt Cross Section',50 1 ,binPt,0.) CALL HBOOKB(2,'Normalisation values',50,binPt,0.0) CALL HBOOKB(-1,'Measured data for Diff mass cross' 1 //' section',50,binPt,0.0) CALL HBOOKB(10,'Z mass',50,binPt,0.0) CALL HIDOPT(0,'stat') CALL HBARX(0) CALL HCDIR('//HISTO/cdfz',' ') CALL HCDIR('//PAWC/cdfz',' ') c c --- basic cuts for rapidity plots rapcut1(1)=1.1 rapcut2(1)=1.1 rapcut2(2)=2.4 rapcut3(1)=2.2 rapcut3(2)=4.2 C ---basic cuts for mass plots masscut(1)=66 masscut(2)=116 C ---basic cuts on Pt Emin1=20 Emin2=15 Emin3=15 WRITE(6,*)'**********************************************' WRITE(6,*)'* HZcdfz called, histograms will be output. *' WRITE(6,*)'**********************************************' 1001 FORMAT(A29,F5.2,A13) ELSE IF (intiflag.eq.2) THEN C *** Filling runs *** C *** Change directory to our graphs *** CALL HCDIR('//PAWC/cdfz',' ') C ******Initilasing all array to 0. DO m=1,NHEP Eelec=0.0 Pxelec=0.0 Pyelec=0.0 Pzelec=0.0 Epos=0.0 Pxpos=0.0 Pypos=0.0 Pzpos=0.0 END DO c ******loop over the particles in the event to find electron c and positron Do loop1=1,NHEP IF (IDHEP(loop1).eq.11)then IF (ISTHEP(loop1).eq.1)then ielec=loop1 Do loop3=1,NHEP IF (IDHEP(loop3).eq.-11)then IF (ISTHEP(loop3).eq.1)then ipos=loop3 Eelec=PHEP(4,ielec) Pxelec=PHEP(1,ielec) Pyelec=PHEP(2,ielec) Pzelec=PHEP(3,ielec) Epos=PHEP(4,ipos) Pxpos=PHEP(1,ipos) Pypos=PHEP(2,ipos) Pzpos=PHEP(3,ipos) c Calculating the total mass of the e+e- pair mtotal=SQRT((Eelec+Epos)**2-(Pxelec+Pxpos)**2 -(Pyelec 1 +Pypos)**2-(Pzelec+Pzpos)**2) c Filling the histogram with the mass CALL hfill(10,real(mtotal),0.0,wtx) c Calculating the transverse energy of the e+ and e- Etelec=SQRT((Pxelec)**2+(pyelec)**2) Etpos=SQRT((Pxpos)**2+(pypos)**2) c Calculating the scattering angle of the e+ and e- Thetaelec=ATAN(Etelec/Pzelec) Thetapos=ATAN(Etpos/pzpos) c Calculating the rapidity of the e+ and e- rapelec=-log(TAN(Thetaelec/2)) rappos=-log(TAN(Thetapos/2)) c Selecting e+e- pairs which lie in the desired range c with the desired,Pt and rap*********** If (((rapelec).gt.ABS(rapcut1(1))).and.Etelec.lt.Emin1) RETURN If(rapelec.lt.ABS(rapcut2(1)).and.rapelec.gt.ABS(rapcut2(2)).and.Etelec 1 .lt.Emin2)RETURN If(rapelec.lt.ABS(rapcut3(1)).and.rapelec.gt.ABS(rapcut3(2)).and.Etelec 2 .lt.Emin3) RETURN If (((rappos).gt.ABS(rapcut1(1))).and.Etpos.lt.Emin1) RETURN If (rappos.lt.ABS(rapcut2(1)).and.rapelec.gt.ABS(rapcut2(2)).and. 1 Etpos.lt.Emin2) RETURN If (rappos.lt.ABS(rapcut3(1)).and.rapelec.gt.ABS(rapcut3(2)).and. 2 Etpos.lt.Emin3) RETURN c Calculating the final transverse energy of the e+e- pair Etpair=SQRT((Pxelec+pxpos)**2+(pyelec+pypos)**2) c Selecting the e+e- pairs which lie in the desired mass range If (mtotal.lt.masscut(1).or.mtotal.gt.masscut(2)) RETURN CALL hfill(3,real(Etpair),0.0,wtx) end if end if end do end if end if end do c this is the end of the Dijet plot c *********************************** ELSE IF (intiflag.eq.3) THEN write(*,*) 'finishing up cdf z.' C *** Termination run *** C *** Change directory *** CALL HCDIR('//PAWC/cdfz',' ') c write(*,*) Ntot c write(*,*) Xsec c Calculating the normalisation values Do loop2=1,50 norm(loop2)=xsec*1.d3/((binPt(loop2+1)-binPt(loop2))*Ntot 1 ) end do c this will store the above numbers in the histogram CALL HPAK(2,norm) CALL HPAKE(2,norme) c this will plot the right cross section, taking into account the c normalised values *********** CALL HOPERA(3,'*E',2,1,1.0,1.0) C fills the histo with real data ***** C CALL HBOOKB(4,'Real data',50,binPt,0.0) CALL HPAK(-1,mass) CALL HPAKE(-1,error) C *** Finish off histograms *** IF (Xsec.eq.0) THEN PRINT*,'CDF Z: termination called with zero xsec' PRINT*,' cross section graph meaningless' Xsec=1 ENDIF IF (Ntot.eq.0) THEN PRINT*,'CDF Z: termination called with no events' PRINT*,' cross section graph meaningless' Ntot=1 ENDIF ELSE c *** End **** print* 1 ,'CDF Inc: Please run routine with iflag set to 1,2 or 3' ENDIF RETURN END