/[PAMELA software]/tracker/ground/source/analysis/momanhough.F
ViewVC logotype

Annotation of /tracker/ground/source/analysis/momanhough.F

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.1.1.1 - (hide annotations) (download) (vendor branch)
Wed Mar 8 15:00:39 2006 UTC (18 years, 9 months ago) by pam-fi
Branch: trk-ground
CVS Tags: R3v02
Changes since 1.1: +0 -0 lines
First CVS release of tracker ground software (R3v02) 

1 pam-fi 1.1 *************************************************************************
2     * Program analysis.f
3     *
4     * - reads cluster information (LEVEL1, reduction.f output ntuple)
5     * - perform track identification and fit
6     * - create LEVEL2 ntuple
7     *
8     *************************************************************************
9     program momanhough
10    
11     include '../common/commontracker.f'
12     include '../common/common_momanhough.f'
13     c include '../common/common_level2debug.f'
14     include '../common/common_mech.f'
15     include '../common/common_xyzPAM.f'
16     include '../common/common_mini_2.f'
17     include '../common/calib.f'
18     include '../common/level1.f'
19     include '../common/level2.f'
20    
21     include '../common/momanhough_init.f'
22    
23     * flag to set debug mode
24     logical DEBUG
25     common/dbg/DEBUG
26     logical DBG_FILLED
27     data DBG_FILLED/.false./
28    
29     * flag to chose PFA
30     character*10 PFA
31     common/FINALPFA/PFA
32    
33    
34     c parameter (inf=1.e8) !just a huge number...
35    
36     * external functions
37     external npl
38     external acoordsi,coordsi,nld,coord,dcoord
39     c------------------------------------------------------------------------
40     c
41     c local variables
42     c
43     c------------------------------------------------------------------------
44    
45     character*24 processing_date
46    
47     parameter (lun_data_level1=71) !data file id number
48     parameter (lun_data_level2=72) !data file id number
49     parameter (lun_data_calib=74) !data file id number
50    
51     character*74 data_file !data file name
52     character*74 data_dir !data file name
53     character*74 data_file_calib
54     character*74 data_file_level1
55     character*74 data_file_level2
56     # ifndef TEST2003
57     parameter(ncalibmax=50)
58     character*40 file_calib(ncalibmax)
59     parameter(lun_calib_list=66) !calibration list file id
60     integer which_calib_last
61     # endif
62    
63     integer minevent !first event to be analysed
64     logical FIMAGE !
65    
66    
67     COMMON/QUEST/IQUEST(100)
68     c !permette di ottenere ntuple funzionanti nonostante
69     c ! il messaggio dei 64K di RZOUT...!???
70    
71     c*****************************************************
72     cccccc 11/9/2005 modified by david fedele
73     c swcode=202
74     cccccc 12/10/2005 modified by Elena Vannuccini
75     swcode=300
76     c****************************************************
77     c------------------------------------------------------------------------
78     c
79     c HBOOK initialization
80     c
81     c------------------------------------------------------------------------
82    
83     call HLIMIT(NWPAWC)
84    
85    
86     c------------------------------------------------------------------------
87     c
88     c reads input informations
89     c
90     c------------------------------------------------------------------------
91     call fdate(processing_date)
92     write(*,101)
93     $ processing_date
94     101 format(/
95     $ ,'*** *** *** *** *** *** *** *** *** *** *** *** ***',/
96     $ ,'* *',/
97     $ ,'* ANALYSIS *',/
98     $ ,'* *',/
99     $ ,'*** *** *** *** *** *** *** *** *** *** *** *** ***',/
100     $ ,a24,/
101     $ )
102    
103     111 format(a)
104     print*,'Data directory:'
105     read(*,111)data_dir
106     print*,data_dir
107     print*,'File identifier: (DATE_NUM)'
108     read(*,*)data_file
109     print*,data_file
110     minevent=1
111     print*,'Maximum number of events to be analized:' !20000
112     read(*,*) ntotev
113     print*,ntotev
114     print*,'Position-finding algorythm: (GOG2,ETA2)'
115     read(*,*)PFA
116     PFA=PFA(1:lnblnk(PFA))
117     print*,PFA
118     print*,'DEBUG mode: (T, F)'
119     11 format(l1)
120     read(*,11)DEBUG
121     print*,DEBUG
122     print*,'---------------------------------------------------'
123    
124    
125     ****** INITIALIZATIONS *************************************
126    
127     * 1) read charge-correlation parameters
128     print*,' '
129     print*,'- read charge-correlation parameters'
130     print*,' '
131     call readchargeparam
132    
133     * 1) read mip parameters
134     print*,' '
135     print*,'- read mip parameters'
136     print*,' '
137     call readmipparam
138    
139     * 2) read z coordinates of the planes
140     print*,' '
141     print*,'- read z coordinates of the planes'
142     print*,' '
143     call mech_sensor !reads sensors centres coordinates
144     do ip=1,nplanes
145     fitz(ip)=z_mech_sensor(ip,1,1)*0.1 !cm
146     * gets planes mechanical z positions
147     * (in mm) and sets them in micrometers
148     enddo
149    
150    
151     * 3) read eta PFA parameters
152     print*,' '
153     print*,'- read P.F.A. parameters'
154     print*,' '
155     call readetaparam
156    
157     print*,' '
158     print*,'- First guess P.F.A. >>>> ',PFAdef
159     print*,' '
160     print*,'- Final P.F.A. >>>> ',PFA
161     print*,' '
162    
163     * 4) read magnetic field map
164     print*,' '
165     print*,'- read magnetic field map'
166     print*,' '
167     c call read_B(5) !legge il nome da STI!!.. temporaneo
168     c call read_B_2maps(5) !legge il nome da STI!!.. temporaneo
169     call read_B
170    
171     * 5) read allignment parameters
172     print*,' '
173     print*,'- read aligment parameters'
174     print*,' '
175     call readalignparam
176    
177     ************************************************************
178    
179    
180    
181    
182    
183     c------------------------------------------------------------------------
184     c
185     c LEVEL 2 ntuple booking
186     c
187     c------------------------------------------------------------------------
188    
189    
190     503 format(a,'DW_',a,'_level2.rz')
191     write(data_file_level2,503)
192     $ data_dir(1:LNBLNK(data_dir))
193     $ ,data_file(1:LNBLNK(data_file))
194    
195     print*,''
196     print*,'------------------------------------'
197     print*,' Creating LEVEL2 rz file'
198     print*,' ',data_file_level2
199     print*,'------------------------------------'
200    
201    
202     C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
203     C largest RZ file: IQUEST(10) records x LREC words x 4 byte
204     C with the following settings: 65000 x 4096 x 4 = 1G
205     C- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
206     IQUEST(10)=65000
207     c !permette di ottenere ntuple funzionanti nonostante
208     c ! il messaggio dei 64K di RZOUT...!???
209     call HROPEN(lun_data_level2,
210     $ 'LEVEL2',data_file_level2,'QNP',4096,istat) !opens rz
211     if(istat.ne.0) goto 19
212     call book_level2
213    
214     if(DEBUG)then
215     print*,'(creating DEBUG nt-uple and histos)'
216     call book_debug
217     endif
218    
219    
220    
221     c------------------------------------------------------------------------
222     c
223     c fills bad variables with online DSP bad strips from calib histograms
224     c for bad strip exclusion
225     c
226     c------------------------------------------------------------------------
227    
228     # ifdef TEST2003
229     c------------------------------------------------------------------------
230     c
231     c opens calib file
232     c
233     c------------------------------------------------------------------------
234    
235     505 format(a,'output_',a,'_calib.rz')
236     write(data_file_calib,505)
237     $ data_dir(1:LNBLNK(data_dir))
238     $ ,data_file(1:LNBLNK(data_file))
239    
240     print*,' '
241     print*,'OPENING CALIB FILE...', data_file_calib
242    
243     IQUEST(10)=65000
244     call HROPEN(lun_data_calib,'IN',data_file_calib,'QP',4096,istat)
245     if(istat.ne.0) goto 17
246     call HCDIR('//IN',' ')
247    
248     call HRIN(0,9999,0) !puts histograms in memory
249    
250     print*,' '
251    
252     print*,' '
253     print*,'READING PEDESTAL, SIGMA AND BADSTRIP HISTOGRAMS...'
254     print*,' '
255    
256     call fillpedsig
257    
258     call HREND('IN')
259     close (lun_data_calib)
260     # else
261    
262     print*,' '
263     print*,'OPENING CALIBRATION-LIST FILE:'
264     501 format(a,'DW_',a,'_calib.txt')
265     write(data_file_calib,501)
266     $ data_dir(1:LNBLNK(data_dir))
267     $ ,data_file(1:LNBLNK(data_file))
268     print*,data_file_calib
269     open(lun_calib_list,
270     $ FILE=data_file_calib(1:LNBLNK(data_file_calib))
271     $ ,STATUS='UNKNOWN'
272     $ ,IOSTAT=iostat
273     $ )
274    
275     113 format(i5,' ',a25)
276    
277     do i=1,ncalibmax
278    
279     read(lun_calib_list,113,IOSTAT=iostat) n_cal_list
280     $ ,file_calib(i)(1:LNBLNK(file_calib(i)))
281     if(iostat.ne.0)then
282     ncal=i-1
283     goto 2000
284     endif
285     print*,n_cal_list,' - '
286     $ ,file_calib(i)(1:LNBLNK(file_calib(i)))
287    
288     enddo
289    
290     2000 close(lun_calib_list)
291     which_calib_last=0
292    
293     # endif
294    
295     c------------------------------------------------------------------------
296     c
297     c opens level1 file
298     c
299     c------------------------------------------------------------------------
300    
301     # ifdef TEST2003
302     504 format(a,'output_',a,'_level1.rz')
303     # else
304     504 format(a,'DW_',a,'_level1.rz')
305     # endif
306     write(data_file_level1,504)
307     $ data_dir(1:LNBLNK(data_dir))
308     $ ,data_file(1:LNBLNK(data_file))
309     print*,''
310     print*,'OPENING LEVEL1 FILE:'
311     print*,data_file_level1
312     IQUEST(10)=65000
313     c !permette di ottenere ntuple funzionanti nonostante
314     c ! il messaggio dei 64K di RZOUT...!???
315     call HROPEN(lun_data_level1,
316     $ 'LEVEL1',data_file_level1,'QP',4096,istat) !opens rz
317     if(istat.ne.0) goto 19
318     call HRIN(ntp_level1,9999,20)
319     call access_level1
320     c call HPRNTU(ntp_level1+20)
321     call HNOENT(ntp_level1+20,iemax0)
322     print*,' events',iemax0
323    
324    
325     ************************************************************
326     ************************************************************
327     ************************************************************
328     *
329     * start track analysis
330     *
331     ************************************************************
332     ************************************************************
333     ************************************************************
334     maxevent=minevent+ntotev-1
335     do iev = minevent,MIN(iemax0,maxevent) !loop on events
336    
337     call HCDIR('//LEVEL1',' ')
338     call HGNT(ntp_level1+20,iev,ierr) !reads an event
339     if(ierr.ne.0) goto 21
340     *------------------------------------------------------
341     * LEVEL2 N-TUPLE INITIALIZATIONS
342     call init_level2
343     if(DEBUG)call init_level2_debug
344     if(DEBUG)DBG_FILLED=.false.
345    
346     if(.not.good1)then
347     goto 8800 !fill nt-uple and go to next event
348     endif
349     *------------------------------------------------------
350    
351    
352     # ifndef TEST2003
353    
354     if(which_calib.ne.which_calib_last.and.
355     $ which_calib.ne.0)then
356    
357     data_file_calib=
358     $ data_dir(1:LNBLNK(data_dir))//
359     $ file_calib(which_calib)
360     $ (1:LNBLNK(file_calib(which_calib)))
361     c print*,data_file_calib
362     print*,''
363     print*,
364     $ '@ event ',nev2
365     $ ,' (CPU pkt N.',pkt_num1,')'
366     print*,'--> ',data_file_calib
367     IQUEST(10)=65000
368     call HROPEN(lun_data_calib,
369     $ 'CALIB',data_file_calib,'QP',4096,istat) !opens
370     if(istat.ne.0) goto 19
371     call HRIN(0,9999,0)
372     call fillpedsig
373     do iview=1,nviews
374     call HDELET(id_hi_bad+iview)
375     call HDELET(id_hi_ped+iview)
376     call HDELET(id_hi_sig+iview)
377     enddo
378     call HREND('CALIB')
379     close(lun_data_calib)
380     which_calib_last=which_calib
381    
382     elseif(which_calib.eq.0)then
383    
384     nocalib=nocalib+1
385     good2=.false.
386     goto 8800 !fill nt-uple and go to next event
387    
388     endif
389    
390     # endif
391    
392    
393     *------------------------------------------------------
394     * cut on maximum number of clusters
395     *------------------------------------------------------
396     if(nclstr1.gt.nclstrmax_level2)then
397     goto 8800 !fill nt-uple and go to next event
398     endif
399    
400     do i=1,nclstr1
401     cl_used(i)=0 !init mask of clusters associated to a track
402     enddo
403    
404     if(DEBUG)then
405     print*,'----------------------------------'
406     print*,iev,' ** ',nev2
407     endif
408    
409     *-------------------------------------------------------------------------------
410     * STEP 1
411     *-------------------------------------------------------------------------------
412     * X-Y cluster association
413     *
414     * Clusters are associated to form COUPLES
415     * Clusters not associated in any couple are called SINGLETS
416     *
417     * Track identification (Hough transform) and fitting is first done on couples.
418     * Hence singlets are possibly added to the track.
419     *
420     * Variables assigned by the routine "cl_to_couples" are those in the
421     * common blocks:
422     * - common/clusters/cl_good
423     * - common/couples/clx,cly,ncp_plane,ncp_tot,cp_useds1,cp_useds2
424     * - common/singlets/ncls,cls,cl_single
425     *-------------------------------------------------------------------------------
426     *-------------------------------------------------------------------------------
427    
428     iflag=0
429     call cl_to_couples(iflag)
430     if(iflag.eq.1)then !bad event
431     goto 880 !fill ntp and go to next event
432     endif
433    
434     *~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
435     * selezione di tracce pulite per diagnostica
436     *~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
437     c$$$ if(DEBUG)then
438     c$$$ do ip=1,nplanes
439     c$$$ if(ncp_plane(ip).ne.1)good2=.false.
440     c$$$ enddo
441     c$$$c if(good2.eq.0)goto 100!next event
442     c$$$c if(good2.eq.0)goto 880!fill ntp and go to next event
443     c$$$ endif
444    
445    
446    
447     *-----------------------------------------------------
448     *-----------------------------------------------------
449     * HOUGH TRASFORM
450     *-----------------------------------------------------
451     *-----------------------------------------------------
452    
453    
454     *-------------------------------------------------------------------------------
455     * STEP 2
456     *-------------------------------------------------------------------------------
457     *
458     * Association of couples to form
459     * - DOUBLETS in YZ view
460     * - TRIPLETS in XZ view
461     *
462     * Variables assigned by the routine "cp_to_doubtrip" are those in the
463     * common blocks:
464     * - common/hough_param/
465     * $ alfayz1, !Y0
466     * $ alfayz2, !tg theta-yz
467     * $ alfaxz1, !X0
468     * $ alfaxz2, !tg theta-xz
469     * $ alfaxz3 !1/r
470     * - common/doublets/ndblt,cpyz1,cpyz2
471     * - common/triplets/ntrpt,cpxz1,cpxz2,cpxz3
472     *-------------------------------------------------------------------------------
473     *-------------------------------------------------------------------------------
474    
475     iflag=0
476     call cp_to_doubtrip(iflag)
477     if(iflag.eq.1)then !bad event
478     goto 880 !fill ntp and go to next event
479     endif
480    
481    
482     *-------------------------------------------------------------------------------
483     * STEP 3
484     *-------------------------------------------------------------------------------
485     *
486     * Classification of doublets and triplets to form CLOUDS,
487     * according to distance in parameter space.
488     *
489     * cloud = cluster of points (doublets/triplets) in parameter space
490     *
491     *
492     *
493     * Variables assigned by the routine "doub_to_YZcloud" are those in the
494     * common blocks:
495     * - common/clouds_yz/
496     * $ nclouds_yz
497     * $ ,alfayz1_av,alfayz2_av
498     * $ ,ptcloud_yz,db_cloud,cpcloud_yz
499     *
500     * Variables assigned by the routine "trip_to_XZcloud" are those in the
501     * common blocks:
502     * common/clouds_xz/
503     * $ nclouds_xz xz2_av,alfaxz3_av
504     * $ ,ptcloud_xz,tr_cloud,cpcloud_xz
505     *-------------------------------------------------------------------------------
506     *-------------------------------------------------------------------------------
507    
508     iflag=0
509     call doub_to_YZcloud(iflag)
510     if(iflag.eq.1)then !bad event
511     goto 880 !fill ntp and go to next event
512     endif
513     iflag=0
514     call trip_to_XZcloud(iflag)
515     if(iflag.eq.1)then !bad event
516     goto 880 !fill ntp and go to next event
517     endif
518    
519     c*****************************************************
520     cccccc 01/12/2005 modified by elena
521     if(DEBUG)then
522     call fill_level2_clouds
523     call HCDIR('//LEVEL2',' ')
524     call HFNT(ntp_level2+1) !fill DEBUG nt-uple
525     DBG_FILLED=.true.
526     endif
527     c*****************************************************
528    
529     *-------------------------------------------------------------------------------
530     * STEP 4 (ITERATED until any other physical track isn't found)
531     *-------------------------------------------------------------------------------
532     *
533     * YZ and XZ clouds are combined in order to obtain the initial guess
534     * of the candidate-track parameters.
535     * A minimum number of matching couples between YZ and XZ clouds is required.
536     *
537     * A TRACK CANDIDATE is defined by
538     * - the couples resulting from the INTERSECTION of the two clouds, and
539     * - the associated track parameters (evaluated by performing a zero-order
540     * track fitting)
541     *
542     * The NTRACKS candidate-track parameters are stored in common block:
543     *
544     * - common/track_candidates/NTRACKS,AL_STORE
545     * $ ,XV_STORE,YV_STORE,ZV_STORE
546     * $ ,XM_STORE,YM_STORE,ZM_STORE
547     * $ ,RESX_STORE,RESY_STORE
548     * $ ,AXV_STORE,AYV_STORE
549     * $ ,XGOOD_STORE,YGOOD_STORE
550     * $ ,CP_STORE,RCHI2_STORE
551     *
552     *-------------------------------------------------------------------------------
553     *-------------------------------------------------------------------------------
554     ntrk=0 !counter of identified physical tracks
555    
556     11111 continue !<<<<<<< come here when performing a new search
557    
558     iflag=0
559     call clouds_to_ctrack(iflag)
560     if(iflag.eq.1)then !no candidate tracks found
561     goto 880 !fill ntp and go to next event
562     endif
563    
564     FIMAGE=.false. !processing best track (not track image)
565     ibest=0 !best track among candidates
566     iimage=0 !track image
567     * ------------- select the best track -------------
568     rchi2best=1000000000.
569     do i=1,ntracks
570     if(RCHI2_STORE(i).lt.rchi2best.and.
571     $ RCHI2_STORE(i).gt.0)then
572     ibest=i
573     rchi2best=RCHI2_STORE(i)
574     endif
575     enddo
576     if(ibest.eq.0)goto 880 !>> no good candidates
577     *-------------------------------------------------------------------------------
578     * The best track candidate (ibest) is selected and a new fitting is performed.
579     * Previous to this, the track is refined by:
580     * - possibly adding new COUPLES or SINGLETS from the missing planes
581     * - evaluating the coordinates with improved PFAs
582     * ( angle-dependent ETA algorithms )
583     *-------------------------------------------------------------------------------
584    
585     1212 continue !<<<<< come here to fit track-image
586    
587     if(.not.FIMAGE)then !processing best candidate
588     icand=ibest
589     else !processing image
590     icand=iimage
591     iimage=0
592     endif
593     if(icand.eq.0)then
594     print*,'HAI FATTO UN CASINO!!!!!! icand = ',icand
595     $ ,ibest,iimage
596     return
597     endif
598    
599     * *-*-*-*-*-*-*-*-*-*-*-*-*-*-*
600     call refine_track(icand)
601     * *-*-*-*-*-*-*-*-*-*-*-*-*-*-*
602    
603     * **********************************************************
604     * ************************** FIT *** FIT *** FIT *** FIT ***
605     * **********************************************************
606     do i=1,5
607     AL(i)=dble(AL_STORE(i,icand))
608     enddo
609     ifail=0 !error flag in chi2 computation
610     jstep=0 !# minimization steps
611    
612     call mini_2(jstep,ifail)
613     if(ifail.ne.0) then
614     if(DEBUG)then
615     print *,
616     $ '*** MINIMIZATION FAILURE *** (mini_2) '
617     $ ,iev
618     endif
619     chi2=-chi2
620     endif
621    
622     if(DEBUG)then
623     print*,'----------------------------- improved track coord'
624     22222 format(i2,' * ',3f10.4,' --- ',4f10.4,' --- ',2f4.0,2f10.5)
625     do ip=1,6
626     write(*,22222)ip,zm(ip),xm(ip),ym(ip)
627     $ ,xm_A(ip),ym_A(ip),xm_B(ip),ym_B(ip)
628     $ ,xgood(ip),ygood(ip),resx(ip),resy(ip)
629     enddo
630     endif
631    
632     c rchi2=chi2/dble(ndof)
633     if(DEBUG)then
634     print*,' '
635     print*,'****** SELECTED TRACK *************'
636     print*,'# R. chi2 RIG'
637     print*,' --- ',chi2,' --- '
638     $ ,1./abs(AL(5))
639     print*,'***********************************'
640     endif
641     * **********************************************************
642     * ************************** FIT *** FIT *** FIT *** FIT ***
643     * **********************************************************
644    
645    
646     * ------------- search if the track has an IMAGE -------------
647     * ------------- (also this is stored ) -------------
648     if(FIMAGE)goto 122 !>>> jump! (this is already an image)
649     * now search for track-image, by comparing couples IDs
650     do i=1,ntracks
651     iimage=i
652     do ip=1,nplanes
653     if( CP_STORE(nplanes-ip+1,icand).ne.
654     $ -1*CP_STORE(nplanes-ip+1,i) )iimage=0
655     enddo
656     if( iimage.ne.0.and.
657     c $ RCHI2_STORE(i).le.CHI2MAX.and.
658     c $ RCHI2_STORE(i).gt.0.and.
659     $ .true.)then
660     if(DEBUG)print*,'Track candidate ',iimage
661     $ ,' >>> TRACK IMAGE >>> of'
662     $ ,ibest
663     goto 122 !image track found
664     endif
665     enddo
666     122 continue
667    
668     * --- and store the results --------------------------------
669     ntrk = ntrk + 1 !counter of found tracks
670     if(.not.FIMAGE
671     $ .and.iimage.eq.0) image(ntrk)= 0
672     if(.not.FIMAGE
673     $ .and.iimage.ne.0)image(ntrk)=ntrk+1 !this is the image of the next
674     if(FIMAGE) image(ntrk)=ntrk-1 !this is the image of the previous
675    
676     call fill_level2_tracks(ntrk) !==> good2=.true.
677     c print*,'++++++++++ iimage,fimage,ntrk,image '
678     c $ ,iimage,fimage,ntrk,image(ntrk)
679    
680     if(ntrk.eq.NTRKMAX)then
681     if(DEBUG)
682     $ print*,
683     $ '** warning ** number of identified '//
684     $ 'tracks exceeds vector dimension '
685     $ ,'( ',NTRKMAX,' )'
686     cc good2=.false.
687     goto 880 !fill ntp and go to next event
688     endif
689     if(iimage.ne.0)then
690     FIMAGE=.true. !
691     goto 1212 !>>> fit image-track
692     endif
693    
694     * --- then remove selected clusters (ibest+iimage) from clouds ----
695     call clean_XYclouds(ibest)
696     if(iflag.eq.1)then !bad event
697     goto 880 !fill ntp and go to next event
698     endif
699    
700     * **********************************************************
701     * condition to start a new search
702     * **********************************************************
703     ixznew=0
704     do ixz=1,nclouds_xz
705     if(ptcloud_xz(ixz).ge.nptxz_min)ixznew=1
706     enddo
707     iyznew=0
708     do iyz=1,nclouds_yz
709     if(ptcloud_yz(iyz).ge.nptyz_min)iyznew=1
710     enddo
711    
712     if(ixznew.ne.0.and.
713     $ iyznew.ne.0.and.
714     $ rchi2best.le.CHI2MAX.and.
715     c $ rchi2best.lt.15..and.
716     $ .true.)then
717     if(DEBUG)then
718     print*,'***** NEW SEARCH ****'
719     endif
720     goto 11111 !try new search
721    
722     endif
723     * **********************************************
724    
725     * >>>>>>>>>>>>>>>>>>> NT-UPLE filling <<<<<<<<<<<<<<<<<<<<
726     * + + + + + + + + + + + + + + + + +
727     * / \ / \ / \ / \ / \ / \ / \ / \ / \ / \ / \ / \ / \ / \ / \ / \ /
728     * + + + + + + + + + + + + + + + + +
729    
730     880 continue
731    
732     * **********************************************************
733     * stores info about clusters not associated with any track
734     * **********************************************************
735    
736     c*****************************************************
737     cccccc 27/9/2005 modified by david fedele
738     * count #cluster per plane not associated to any track
739     c$$$ do icl=1,nclstr1
740     c$$$ if(cl_used(icl).eq.0)then !cluster not included in any track
741     c$$$ ip=nplanes-npl(VIEW(icl))+1
742     c$$$ if(mod(VIEW(icl),2).eq.0)nclsx(ip)=nclsx(ip)+1
743     c$$$ if(mod(VIEW(icl),2).eq.1)nclsy(ip)=nclsy(ip)+1
744     c$$$ endif
745     c$$$c print*,icl,cl_used(icl),cl_good(icl),ip,VIEW(icl)!nclsx(ip),nclsy(ip)
746     c$$$ enddo
747     c**********************************************************************
748    
749     call fill_level2_siglets
750    
751     c print*,'****** ',iev,' - ',ntrk,nclsx,nclsy
752     c print*,'****** ',iev,' - ',ntrk,' --- ',(BdL(i),i=1,ntrk)
753    
754     if(DEBUG)then
755    
756     print*,''
757     print*,'DONE!'
758     print*,''
759     print*,'* summary *'
760     print*,'tracks ',ntrk
761     print*,'cl used ',(cl_used(i),i=1,nclstr1)
762     c*****************************************************
763     c$$$cccccc 27/9/2005 modified by david fedele
764     c$$$ print*,'cl unused (x-y)'
765     c$$$ do ip=1,nplanes
766     c$$$ print*,ip,' << ',nclsx(ip),nclsy(ip)
767     c$$$ enddo
768     c******************************************************
769     print*,''
770     print*,''
771     endif
772    
773     8800 continue
774    
775     call HCDIR('//LEVEL2',' ')
776     call HFNT(ntp_level2) !fill LEVEL2 nt-uple
777     if(.not.DBG_FILLED.and.DEBUG)
778     $ print*,'@@@@@@@@@@@@',ntp_level2+1,nev2_nt
779     if(.not.DBG_FILLED.and.DEBUG)call HFNT(ntp_level2+1)
780    
781     100 continue
782     enddo !end loop on events
783    
784     c------------------------------------------------------------------------
785     c
786     c no error exit
787     c
788     c------------------------------------------------------------------------
789    
790     c$$$ print*,' '
791     c$$$ print*,'REDUCTION SUCCESSFULLY COMPLETED'
792     c$$$ print*,' '
793     c$$$ print*,' '
794    
795     goto 9000 !happy ending
796    
797    
798     c------------------------------------------------------------------------
799     c
800     c data file opening error
801     c
802     c------------------------------------------------------------------------
803     19 continue
804    
805     print*,' '
806     print*,'ERROR OPENING DATA FILE: ',data_file
807     print*,' '
808     print*,' '
809    
810     goto 9000 !the end
811    
812     c------------------------------------------------------------------------
813     c
814     c level1 ntuple event reading error
815     c
816     c------------------------------------------------------------------------
817    
818     21 continue
819    
820     print*,' '
821     print*,'ERROR WHILE READING LEVEL1 NTUPLE, AT EVENT
822     $ : ',iev
823     print*,' '
824     print*,' '
825    
826     goto 9000 !the end
827    
828     c------------------------------------------------------------------------
829     c
830     c calib file opening error
831     c
832     c------------------------------------------------------------------------
833    
834     17 continue
835    
836     print*,' '
837     print*,'preanalysis: ERROR OPENING INPUT FILE: ',data_file_calib
838     print*,' '
839     print*,' '
840    
841     goto 9000 !the end
842    
843     c------------------------------------------------------------------------
844     c
845     c closes files and exits
846     c
847     c------------------------------------------------------------------------
848    
849     9000 continue
850    
851     if(DEBUG)call HPRNTU(ntp_level2+1)
852     call HPRNTU(ntp_level2)
853     print*,''
854     call HCDIR('//LEVEL2',' ')
855     call HROUT(ntp_level2,ICYCLE,'T')
856     print *,'- Stored LEVEL2 nt-uple (',nev2,' entries )'
857     if(DEBUG)call HROUT(ntp_level2+1,ICYCLE,'T')
858     if(DEBUG)print *,'- Stored DEBUG nt-uple '
859     call HREND('level2')
860     close(lun_data_level2)
861    
862     call HCDIR('//LEVEL1',' ')
863     call HREND('level1')
864     close(lun_data_level1)
865    
866     stop
867     end
868    
869    
870     ************************************************************
871    
872    
873     # include "momanhough-subroutines.F"
874    
875    

  ViewVC Help
Powered by ViewVC 1.1.23