************************************************************************* * Program analysis.f * * - reads cluster information (LEVEL1, reduction.f output ntuple) * - perform track identification and fit * - create LEVEL2 ntuple * ************************************************************************* program momanhough include '../common/commontracker.f' include '../common/common_momanhough.f' c include '../common/common_level2debug.f' include '../common/common_mech.f' include '../common/common_xyzPAM.f' include '../common/common_mini_2.f' include '../common/calib.f' include '../common/level1.f' include '../common/level2.f' c include '../common/momanhough_init.f' * flag to set debug mode logical DEBUG common/dbg/DEBUG logical DBG_FILLED data DBG_FILLED/.false./ * flag to chose PFA character*10 PFA common/FINALPFA/PFA c parameter (inf=1.e8) !just a huge number... * external functions external npl external acoordsi,coordsi,nld,coord,dcoord c------------------------------------------------------------------------ c c local variables c c------------------------------------------------------------------------ character*24 processing_date parameter (lun_data_level1=71) !data file id number parameter (lun_data_level2=72) !data file id number parameter (lun_data_calib=74) !data file id number character*74 data_file !data file name character*74 data_dir !data file name character*74 data_file_calib character*74 data_file_level1 character*74 data_file_level2 # ifndef TEST2003 parameter(ncalibmax=50) character*40 file_calib(ncalibmax) parameter(lun_calib_list=66) !calibration list file id integer which_calib_last # endif integer minevent !first event to be analysed c logical FIMAGE ! COMMON/QUEST/IQUEST(100) c !permette di ottenere ntuple funzionanti nonostante c ! il messaggio dei 64K di RZOUT...!??? c***************************************************** cccccc 11/9/2005 modified by david fedele c swcode=202 cccccc 12/10/2005 modified by Elena Vannuccini swcode=300 c**************************************************** c------------------------------------------------------------------------ c c HBOOK initialization c c------------------------------------------------------------------------ call HLIMIT(NWPAWC) c------------------------------------------------------------------------ c c reads input informations c c------------------------------------------------------------------------ call fdate(processing_date) write(*,101) $ processing_date 101 format(/ $ ,'*** *** *** *** *** *** *** *** *** *** *** *** ***',/ $ ,'* *',/ $ ,'* ANALYSIS *',/ $ ,'* *',/ $ ,'*** *** *** *** *** *** *** *** *** *** *** *** ***',/ $ ,a24,/ $ ) 111 format(a) print*,'Data directory:' read(*,111)data_dir print*,data_dir print*,'File identifier: (DATE_NUM)' read(*,*)data_file print*,data_file minevent=1 print*,'Maximum number of events to be analized:' !20000 read(*,*) ntotev print*,ntotev print*,'Position-finding algorythm: (GOG2,ETA2)' read(*,*)PFA PFA=PFA(1:lnblnk(PFA)) print*,PFA print*,'DEBUG mode: (T, F)' 11 format(l1) read(*,11)DEBUG print*,DEBUG print*,'---------------------------------------------------' ****** INITIALIZATIONS ************************************* * 1) read charge-correlation parameters print*,' ' print*,'- read charge-correlation parameters' print*,' ' call readchargeparam * 1) read mip parameters print*,' ' print*,'- read mip parameters' print*,' ' call readmipparam * 2) read z coordinates of the planes print*,' ' print*,'- read z coordinates of the planes' print*,' ' call mech_sensor !reads sensors centres coordinates do ip=1,nplanes fitz(ip)=z_mech_sensor(ip,1,1)*0.1 !cm * gets planes mechanical z positions * (in mm) and sets them in micrometers enddo * 3) read eta PFA parameters print*,' ' print*,'- read P.F.A. parameters' print*,' ' call readetaparam print*,' ' print*,'- First guess P.F.A. >>>> ',PFAdef print*,' ' print*,'- Final P.F.A. >>>> ',PFA print*,' ' * 4) read magnetic field map print*,' ' print*,'- read magnetic field map' print*,' ' c call read_B(5) !legge il nome da STI!!.. temporaneo c call read_B_2maps(5) !legge il nome da STI!!.. temporaneo call read_B * 5) read allignment parameters print*,' ' print*,'- read aligment parameters' print*,' ' call readalignparam ************************************************************ c------------------------------------------------------------------------ c c LEVEL 2 ntuple booking c c------------------------------------------------------------------------ 503 format(a,'DW_',a,'_level2.rz') write(data_file_level2,503) $ data_dir(1:LNBLNK(data_dir)) $ ,data_file(1:LNBLNK(data_file)) print*,'' print*,'------------------------------------' print*,' Creating LEVEL2 rz file' print*,' ',data_file_level2 print*,'------------------------------------' C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - C largest RZ file: IQUEST(10) records x LREC words x 4 byte C with the following settings: 65000 x 4096 x 4 = 1G C- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - IQUEST(10)=65000 c !permette di ottenere ntuple funzionanti nonostante c ! il messaggio dei 64K di RZOUT...!??? call HROPEN(lun_data_level2, $ 'LEVEL2',data_file_level2,'QNP',4096,istat) !opens rz if(istat.ne.0) goto 19 call book_level2 if(DEBUG)then print*,'(creating DEBUG nt-uple and histos)' call book_debug endif c------------------------------------------------------------------------ c c fills bad variables with online DSP bad strips from calib histograms c for bad strip exclusion c c------------------------------------------------------------------------ # ifdef TEST2003 c------------------------------------------------------------------------ c c opens calib file c c------------------------------------------------------------------------ 505 format(a,'output_',a,'_calib.rz') write(data_file_calib,505) $ data_dir(1:LNBLNK(data_dir)) $ ,data_file(1:LNBLNK(data_file)) print*,' ' print*,'OPENING CALIB FILE...', data_file_calib IQUEST(10)=65000 call HROPEN(lun_data_calib,'IN',data_file_calib,'QP',4096,istat) if(istat.ne.0) goto 17 call HCDIR('//IN',' ') call HRIN(0,9999,0) !puts histograms in memory print*,' ' print*,' ' print*,'READING PEDESTAL, SIGMA AND BADSTRIP HISTOGRAMS...' print*,' ' call fillpedsig call HREND('IN') close (lun_data_calib) # else print*,' ' print*,'OPENING CALIBRATION-LIST FILE:' 501 format(a,'DW_',a,'_calib.txt') write(data_file_calib,501) $ data_dir(1:LNBLNK(data_dir)) $ ,data_file(1:LNBLNK(data_file)) print*,data_file_calib open(lun_calib_list, $ FILE=data_file_calib(1:LNBLNK(data_file_calib)) $ ,STATUS='UNKNOWN' $ ,IOSTAT=iostat $ ) 113 format(i5,' ',a25) do i=1,ncalibmax read(lun_calib_list,113,IOSTAT=iostat) n_cal_list $ ,file_calib(i)(1:LNBLNK(file_calib(i))) if(iostat.ne.0)then ncal=i-1 goto 2000 endif print*,n_cal_list,' - ' $ ,file_calib(i)(1:LNBLNK(file_calib(i))) enddo 2000 close(lun_calib_list) which_calib_last=0 # endif c------------------------------------------------------------------------ c c opens level1 file c c------------------------------------------------------------------------ # ifdef TEST2003 504 format(a,'output_',a,'_level1.rz') # else 504 format(a,'DW_',a,'_level1.rz') # endif write(data_file_level1,504) $ data_dir(1:LNBLNK(data_dir)) $ ,data_file(1:LNBLNK(data_file)) print*,'' print*,'OPENING LEVEL1 FILE:' print*,data_file_level1 IQUEST(10)=65000 c !permette di ottenere ntuple funzionanti nonostante c ! il messaggio dei 64K di RZOUT...!??? call HROPEN(lun_data_level1, $ 'LEVEL1',data_file_level1,'QP',4096,istat) !opens rz if(istat.ne.0) goto 19 call HRIN(ntp_level1,9999,20) call access_level1 c call HPRNTU(ntp_level1+20) call HNOENT(ntp_level1+20,iemax0) print*,' events',iemax0 ************************************************************ ************************************************************ ************************************************************ * * start track analysis * ************************************************************ ************************************************************ ************************************************************ maxevent=minevent+ntotev-1 do iev = minevent,MIN(iemax0,maxevent) !loop on events call HCDIR('//LEVEL1',' ') call HGNT(ntp_level1+20,iev,ierr) !reads an event if(ierr.ne.0) goto 21 *------------------------------------------------------ * LEVEL2 N-TUPLE INITIALIZATIONS call init_level2 if(DEBUG)call init_level2_debug if(DEBUG)DBG_FILLED=.false. if(.not.good1)then goto 8800 !fill nt-uple and go to next event endif *------------------------------------------------------ # ifndef TEST2003 if(which_calib.ne.which_calib_last.and. $ which_calib.ne.0)then data_file_calib= $ data_dir(1:LNBLNK(data_dir))// $ file_calib(which_calib) $ (1:LNBLNK(file_calib(which_calib))) c print*,data_file_calib print*,'' print*, $ '@ event ',nev2 $ ,' (CPU pkt N.',pkt_num1,')' print*,'--> ',data_file_calib IQUEST(10)=65000 call HROPEN(lun_data_calib, $ 'CALIB',data_file_calib,'QP',4096,istat) !opens if(istat.ne.0) goto 19 call HRIN(0,9999,0) call fillpedsig do iview=1,nviews call HDELET(id_hi_bad+iview) call HDELET(id_hi_ped+iview) call HDELET(id_hi_sig+iview) enddo call HREND('CALIB') close(lun_data_calib) which_calib_last=which_calib elseif(which_calib.eq.0)then nocalib=nocalib+1 good2=.false. goto 8800 !fill nt-uple and go to next event endif # endif *------------------------------------------------------ * cut on maximum number of clusters *------------------------------------------------------ if(nclstr1.gt.nclstrmax_level2)then goto 8800 !fill nt-uple and go to next event endif do i=1,nclstr1 cl_used(i)=0 !init mask of clusters associated to a track enddo if(DEBUG)then print*,'----------------------------------' print*,iev,' ** ',nev2 endif * /////////////////////////////////////////////// * \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ iflag=0 call track_finding(iflag) if(iflag.eq.1)then !bad event goto 880 !fill ntp and go to next event endif c$$$*------------------------------------------------------------------------------- c$$$* STEP 1 c$$$*------------------------------------------------------------------------------- c$$$* X-Y cluster association c$$$* c$$$* Clusters are associated to form COUPLES c$$$* Clusters not associated in any couple are called SINGLETS c$$$* c$$$* Track identification (Hough transform) and fitting is first done on couples. c$$$* Hence singlets are possibly added to the track. c$$$* c$$$* Variables assigned by the routine "cl_to_couples" are those in the c$$$* common blocks: c$$$* - common/clusters/cl_good c$$$* - common/couples/clx,cly,ncp_plane,ncp_tot,cp_useds1,cp_useds2 c$$$* - common/singlets/ncls,cls,cl_single c$$$*------------------------------------------------------------------------------- c$$$*------------------------------------------------------------------------------- c$$$ c$$$ iflag=0 c$$$ call cl_to_couples(iflag) c$$$ if(iflag.eq.1)then !bad event c$$$ goto 880 !fill ntp and go to next event c$$$ endif c$$$ c$$$*~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ c$$$* selezione di tracce pulite per diagnostica c$$$*~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ c$$$c$$$ if(DEBUG)then c$$$c$$$ do ip=1,nplanes c$$$c$$$ if(ncp_plane(ip).ne.1)good2=.false. c$$$c$$$ enddo c$$$c$$$c if(good2.eq.0)goto 100!next event c$$$c$$$c if(good2.eq.0)goto 880!fill ntp and go to next event c$$$c$$$ endif c$$$ c$$$ c$$$ c$$$*----------------------------------------------------- c$$$*----------------------------------------------------- c$$$* HOUGH TRASFORM c$$$*----------------------------------------------------- c$$$*----------------------------------------------------- c$$$ c$$$ c$$$*------------------------------------------------------------------------------- c$$$* STEP 2 c$$$*------------------------------------------------------------------------------- c$$$* c$$$* Association of couples to form c$$$* - DOUBLETS in YZ view c$$$* - TRIPLETS in XZ view c$$$* c$$$* Variables assigned by the routine "cp_to_doubtrip" are those in the c$$$* common blocks: c$$$* - common/hough_param/ c$$$* $ alfayz1, !Y0 c$$$* $ alfayz2, !tg theta-yz c$$$* $ alfaxz1, !X0 c$$$* $ alfaxz2, !tg theta-xz c$$$* $ alfaxz3 !1/r c$$$* - common/doublets/ndblt,cpyz1,cpyz2 c$$$* - common/triplets/ntrpt,cpxz1,cpxz2,cpxz3 c$$$*------------------------------------------------------------------------------- c$$$*------------------------------------------------------------------------------- c$$$ c$$$ iflag=0 c$$$ call cp_to_doubtrip(iflag) c$$$ if(iflag.eq.1)then !bad event c$$$ goto 880 !fill ntp and go to next event c$$$ endif c$$$ c$$$ c$$$*------------------------------------------------------------------------------- c$$$* STEP 3 c$$$*------------------------------------------------------------------------------- c$$$* c$$$* Classification of doublets and triplets to form CLOUDS, c$$$* according to distance in parameter space. c$$$* c$$$* cloud = cluster of points (doublets/triplets) in parameter space c$$$* c$$$* c$$$* c$$$* Variables assigned by the routine "doub_to_YZcloud" are those in the c$$$* common blocks: c$$$* - common/clouds_yz/ c$$$* $ nclouds_yz c$$$* $ ,alfayz1_av,alfayz2_av c$$$* $ ,ptcloud_yz,db_cloud,cpcloud_yz c$$$* c$$$* Variables assigned by the routine "trip_to_XZcloud" are those in the c$$$* common blocks: c$$$* common/clouds_xz/ c$$$* $ nclouds_xz xz2_av,alfaxz3_av c$$$* $ ,ptcloud_xz,tr_cloud,cpcloud_xz c$$$*------------------------------------------------------------------------------- c$$$*------------------------------------------------------------------------------- c$$$ c$$$ iflag=0 c$$$ call doub_to_YZcloud(iflag) c$$$ if(iflag.eq.1)then !bad event c$$$ goto 880 !fill ntp and go to next event c$$$ endif c$$$ iflag=0 c$$$ call trip_to_XZcloud(iflag) c$$$ if(iflag.eq.1)then !bad event c$$$ goto 880 !fill ntp and go to next event c$$$ endif c$$$ c***************************************************** cccccc 01/12/2005 modified by elena if(DEBUG)then call fill_level2_clouds call HCDIR('//LEVEL2',' ') call HFNT(ntp_level2+1) !fill DEBUG nt-uple DBG_FILLED=.true. endif c***************************************************** iflag=0 call track_fitting(iflag) if(iflag.eq.1)then !bad event goto 880 !fill ntp and go to next event endif c$$$ c$$$*------------------------------------------------------------------------------- c$$$* STEP 4 (ITERATED until any other physical track isn't found) c$$$*------------------------------------------------------------------------------- c$$$* c$$$* YZ and XZ clouds are combined in order to obtain the initial guess c$$$* of the candidate-track parameters. c$$$* A minimum number of matching couples between YZ and XZ clouds is required. c$$$* c$$$* A TRACK CANDIDATE is defined by c$$$* - the couples resulting from the INTERSECTION of the two clouds, and c$$$* - the associated track parameters (evaluated by performing a zero-order c$$$* track fitting) c$$$* c$$$* The NTRACKS candidate-track parameters are stored in common block: c$$$* c$$$* - common/track_candidates/NTRACKS,AL_STORE c$$$* $ ,XV_STORE,YV_STORE,ZV_STORE c$$$* $ ,XM_STORE,YM_STORE,ZM_STORE c$$$* $ ,RESX_STORE,RESY_STORE c$$$* $ ,AXV_STORE,AYV_STORE c$$$* $ ,XGOOD_STORE,YGOOD_STORE c$$$* $ ,CP_STORE,RCHI2_STORE c$$$* c$$$*------------------------------------------------------------------------------- c$$$*------------------------------------------------------------------------------- c$$$ ntrk=0 !counter of identified physical tracks c$$$ c$$$11111 continue !<<<<<<< come here when performing a new search c$$$ c$$$ iflag=0 c$$$ call clouds_to_ctrack(iflag) c$$$ if(iflag.eq.1)then !no candidate tracks found c$$$ goto 880 !fill ntp and go to next event c$$$ endif c$$$ c$$$ FIMAGE=.false. !processing best track (not track image) c$$$ ibest=0 !best track among candidates c$$$ iimage=0 !track image c$$$* ------------- select the best track ------------- c$$$ rchi2best=1000000000. c$$$ do i=1,ntracks c$$$ if(RCHI2_STORE(i).lt.rchi2best.and. c$$$ $ RCHI2_STORE(i).gt.0)then c$$$ ibest=i c$$$ rchi2best=RCHI2_STORE(i) c$$$ endif c$$$ enddo c$$$ if(ibest.eq.0)goto 880 !>> no good candidates c$$$*------------------------------------------------------------------------------- c$$$* The best track candidate (ibest) is selected and a new fitting is performed. c$$$* Previous to this, the track is refined by: c$$$* - possibly adding new COUPLES or SINGLETS from the missing planes c$$$* - evaluating the coordinates with improved PFAs c$$$* ( angle-dependent ETA algorithms ) c$$$*------------------------------------------------------------------------------- c$$$ c$$$ 1212 continue !<<<<< come here to fit track-image c$$$ c$$$ if(.not.FIMAGE)then !processing best candidate c$$$ icand=ibest c$$$ else !processing image c$$$ icand=iimage c$$$ iimage=0 c$$$ endif c$$$ if(icand.eq.0)then c$$$ print*,'HAI FATTO UN CASINO!!!!!! icand = ',icand c$$$ $ ,ibest,iimage c$$$ return c$$$ endif c$$$ c$$$* *-*-*-*-*-*-*-*-*-*-*-*-*-*-* c$$$ call refine_track(icand) c$$$* *-*-*-*-*-*-*-*-*-*-*-*-*-*-* c$$$ c$$$* ********************************************************** c$$$* ************************** FIT *** FIT *** FIT *** FIT *** c$$$* ********************************************************** c$$$ do i=1,5 c$$$ AL(i)=dble(AL_STORE(i,icand)) c$$$ enddo c$$$ ifail=0 !error flag in chi2 computation c$$$ jstep=0 !# minimization steps c$$$ c$$$ call mini_2(jstep,ifail) c$$$ if(ifail.ne.0) then c$$$ if(DEBUG)then c$$$ print *, c$$$ $ '*** MINIMIZATION FAILURE *** (mini_2) ' c$$$ $ ,iev c$$$ endif c$$$ chi2=-chi2 c$$$ endif c$$$ c$$$ if(DEBUG)then c$$$ print*,'----------------------------- improved track coord' c$$$22222 format(i2,' * ',3f10.4,' --- ',4f10.4,' --- ',2f4.0,2f10.5) c$$$ do ip=1,6 c$$$ write(*,22222)ip,zm(ip),xm(ip),ym(ip) c$$$ $ ,xm_A(ip),ym_A(ip),xm_B(ip),ym_B(ip) c$$$ $ ,xgood(ip),ygood(ip),resx(ip),resy(ip) c$$$ enddo c$$$ endif c$$$ c$$$c rchi2=chi2/dble(ndof) c$$$ if(DEBUG)then c$$$ print*,' ' c$$$ print*,'****** SELECTED TRACK *************' c$$$ print*,'# R. chi2 RIG' c$$$ print*,' --- ',chi2,' --- ' c$$$ $ ,1./abs(AL(5)) c$$$ print*,'***********************************' c$$$ endif c$$$* ********************************************************** c$$$* ************************** FIT *** FIT *** FIT *** FIT *** c$$$* ********************************************************** c$$$ c$$$ c$$$* ------------- search if the track has an IMAGE ------------- c$$$* ------------- (also this is stored ) ------------- c$$$ if(FIMAGE)goto 122 !>>> jump! (this is already an image) c$$$* now search for track-image, by comparing couples IDs c$$$ do i=1,ntracks c$$$ iimage=i c$$$ do ip=1,nplanes c$$$ if( CP_STORE(nplanes-ip+1,icand).ne. c$$$ $ -1*CP_STORE(nplanes-ip+1,i) )iimage=0 c$$$ enddo c$$$ if( iimage.ne.0.and. c$$$c $ RCHI2_STORE(i).le.CHI2MAX.and. c$$$c $ RCHI2_STORE(i).gt.0.and. c$$$ $ .true.)then c$$$ if(DEBUG)print*,'Track candidate ',iimage c$$$ $ ,' >>> TRACK IMAGE >>> of' c$$$ $ ,ibest c$$$ goto 122 !image track found c$$$ endif c$$$ enddo c$$$ 122 continue c$$$ c$$$* --- and store the results -------------------------------- c$$$ ntrk = ntrk + 1 !counter of found tracks c$$$ if(.not.FIMAGE c$$$ $ .and.iimage.eq.0) image(ntrk)= 0 c$$$ if(.not.FIMAGE c$$$ $ .and.iimage.ne.0)image(ntrk)=ntrk+1 !this is the image of the next c$$$ if(FIMAGE) image(ntrk)=ntrk-1 !this is the image of the previous c$$$ c$$$ call fill_level2_tracks(ntrk) !==> good2=.true. c$$$c print*,'++++++++++ iimage,fimage,ntrk,image ' c$$$c $ ,iimage,fimage,ntrk,image(ntrk) c$$$ c$$$ if(ntrk.eq.NTRKMAX)then c$$$ if(DEBUG) c$$$ $ print*, c$$$ $ '** warning ** number of identified '// c$$$ $ 'tracks exceeds vector dimension ' c$$$ $ ,'( ',NTRKMAX,' )' c$$$cc good2=.false. c$$$ goto 880 !fill ntp and go to next event c$$$ endif c$$$ if(iimage.ne.0)then c$$$ FIMAGE=.true. ! c$$$ goto 1212 !>>> fit image-track c$$$ endif c$$$ c$$$* --- then remove selected clusters (ibest+iimage) from clouds ---- c$$$ call clean_XYclouds(ibest) c$$$ if(iflag.eq.1)then !bad event c$$$ goto 880 !fill ntp and go to next event c$$$ endif c$$$ c$$$* ********************************************************** c$$$* condition to start a new search c$$$* ********************************************************** c$$$ ixznew=0 c$$$ do ixz=1,nclouds_xz c$$$ if(ptcloud_xz(ixz).ge.nptxz_min)ixznew=1 c$$$ enddo c$$$ iyznew=0 c$$$ do iyz=1,nclouds_yz c$$$ if(ptcloud_yz(iyz).ge.nptyz_min)iyznew=1 c$$$ enddo c$$$ c$$$ if(ixznew.ne.0.and. c$$$ $ iyznew.ne.0.and. c$$$ $ rchi2best.le.CHI2MAX.and. c$$$c $ rchi2best.lt.15..and. c$$$ $ .true.)then c$$$ if(DEBUG)then c$$$ print*,'***** NEW SEARCH ****' c$$$ endif c$$$ goto 11111 !try new search c$$$ c$$$ endif c$$$* ********************************************** c$$$ * >>>>>>>>>>>>>>>>>>> NT-UPLE filling <<<<<<<<<<<<<<<<<<<< * + + + + + + + + + + + + + + + + + * / \ / \ / \ / \ / \ / \ / \ / \ / \ / \ / \ / \ / \ / \ / \ / \ / * + + + + + + + + + + + + + + + + + 880 continue * ********************************************************** * stores info about clusters not associated with any track * ********************************************************** c***************************************************** cccccc 27/9/2005 modified by david fedele * count #cluster per plane not associated to any track c$$$ do icl=1,nclstr1 c$$$ if(cl_used(icl).eq.0)then !cluster not included in any track c$$$ ip=nplanes-npl(VIEW(icl))+1 c$$$ if(mod(VIEW(icl),2).eq.0)nclsx(ip)=nclsx(ip)+1 c$$$ if(mod(VIEW(icl),2).eq.1)nclsy(ip)=nclsy(ip)+1 c$$$ endif c$$$c print*,icl,cl_used(icl),cl_good(icl),ip,VIEW(icl)!nclsx(ip),nclsy(ip) c$$$ enddo c********************************************************************** call fill_level2_siglets c print*,'****** ',iev,' - ',ntrk,nclsx,nclsy c print*,'****** ',iev,' - ',ntrk,' --- ',(BdL(i),i=1,ntrk) if(DEBUG)then print*,'' print*,'DONE!' print*,'' print*,'* summary *' print*,'tracks ',ntrk print*,'cl used ',(cl_used(i),i=1,nclstr1) c***************************************************** c$$$cccccc 27/9/2005 modified by david fedele c$$$ print*,'cl unused (x-y)' c$$$ do ip=1,nplanes c$$$ print*,ip,' << ',nclsx(ip),nclsy(ip) c$$$ enddo c****************************************************** print*,'' print*,'' endif 8800 continue * /////////////////////////////////////////////// * \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ call HCDIR('//LEVEL2',' ') call HFNT(ntp_level2) !fill LEVEL2 nt-uple if(.not.DBG_FILLED.and.DEBUG) $ print*,'@@@@@@@@@@@@',ntp_level2+1,nev2_nt if(.not.DBG_FILLED.and.DEBUG)call HFNT(ntp_level2+1) 100 continue enddo !end loop on events c------------------------------------------------------------------------ c c no error exit c c------------------------------------------------------------------------ c$$$ print*,' ' c$$$ print*,'REDUCTION SUCCESSFULLY COMPLETED' c$$$ print*,' ' c$$$ print*,' ' goto 9000 !happy ending c------------------------------------------------------------------------ c c data file opening error c c------------------------------------------------------------------------ 19 continue print*,' ' print*,'ERROR OPENING DATA FILE: ',data_file print*,' ' print*,' ' goto 9000 !the end c------------------------------------------------------------------------ c c level1 ntuple event reading error c c------------------------------------------------------------------------ 21 continue print*,' ' print*,'ERROR WHILE READING LEVEL1 NTUPLE, AT EVENT $ : ',iev print*,' ' print*,' ' goto 9000 !the end c------------------------------------------------------------------------ c c calib file opening error c c------------------------------------------------------------------------ 17 continue print*,' ' print*,'preanalysis: ERROR OPENING INPUT FILE: ',data_file_calib print*,' ' print*,' ' goto 9000 !the end c------------------------------------------------------------------------ c c closes files and exits c c------------------------------------------------------------------------ 9000 continue if(DEBUG)call HPRNTU(ntp_level2+1) call HPRNTU(ntp_level2) print*,'' call HCDIR('//LEVEL2',' ') call HROUT(ntp_level2,ICYCLE,'T') print *,'- Stored LEVEL2 nt-uple (',nev2,' entries )' if(DEBUG)call HROUT(ntp_level2+1,ICYCLE,'T') if(DEBUG)print *,'- Stored DEBUG nt-uple ' call HREND('level2') close(lun_data_level2) call HCDIR('//LEVEL1',' ') call HREND('level1') close(lun_data_level1) stop end ************************************************************ # include "momanhough-subroutines.F"