/[PAMELA software]/DarthVader/TrackerLevel2/src/F77/mini.f
ViewVC logotype

Annotation of /DarthVader/TrackerLevel2/src/F77/mini.f

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.18 - (hide annotations) (download)
Fri Jun 1 15:01:19 2007 UTC (17 years, 6 months ago) by pam-fi
Branch: MAIN
Changes since 1.17: +13 -3 lines
*** empty log message ***

1 mocchiut 1.1 ************************************************************************
2     *
3     * subroutine to evaluate the vector alfa (AL)
4     * which minimizes CHI^2
5     *
6     * - modified from mini.f in order to call differente chi^2 routine.
7     * The new one includes also single clusters: in this case
8     * the residual is defined as the distance between the track and the
9     * segment AB associated to the single cluster.
10     *
11     *
12     ************************************************************************
13    
14    
15 pam-fi 1.3 SUBROUTINE MINI2(ISTEP,IFAIL,IPRINT)
16 mocchiut 1.1
17     IMPLICIT DOUBLE PRECISION (A-H,O-Z)
18    
19     include 'commontracker.f' !tracker general common
20     include 'common_mini_2.f' !common for the tracking procedure
21    
22 pam-fi 1.2 c logical DEBUG
23     c common/dbg/DEBUG
24 mocchiut 1.1
25 pam-fi 1.4 parameter (dinf=1.d15) !just a huge number...
26 mocchiut 1.1 c------------------------------------------------------------------------
27     c variables used in the tracking procedure (mini and its subroutines)
28     c
29     c N.B.: in mini & C. (and in the following block of variables too)
30     c the plane ordering is reversed in respect of normal
31     c ordering, but they maintain their Z coordinates. so plane number 1 is
32     c the first one that a particle meets, and its Z coordinate is > 0
33     c------------------------------------------------------------------------
34 pam-fi 1.3 DATA ZINI/23.5/ !!! ***PP*** to be changed !z coordinate of the reference plane
35 mocchiut 1.1
36 pam-fi 1.3 c DATA XGOOD,YGOOD/nplanes*1.,nplanes*1./ !planes to be used in the tracking
37 mocchiut 1.1
38     DATA STEPAL/5*1.d-7/ !alpha vector step
39 pam-fi 1.7 DATA ISTEPMAX/100/ !maximum number of steps in the chi^2 minimization
40 mocchiut 1.1 DATA TOLL/1.d-8/ !tolerance in reaching the next plane during
41     * !the tracking procedure
42     DATA STEPMAX/100./ !maximum number of steps in the trackin gprocess
43    
44 pam-fi 1.8 c DATA ALMAX/dinf,dinf,1.,dinf,dinf/ !limits on alpha vector components
45     c DATA ALMIN/-dinf,-dinf,-1.,-dinf,-dinf/ !"
46 pam-fi 1.10 DATA ALMAX/dinf,dinf,1.,dinf,dinf/ !limits on alpha vector components
47     DATA ALMIN/-dinf,-dinf,-1.,-dinf,-dinf/ !"
48 mocchiut 1.1
49 pam-fi 1.17 c$$$ DIMENSION DAL(5) !increment of vector alfa
50 pam-fi 1.3 DIMENSION CHI2DD_R(4,4),CHI2D_R(4) !hessiano e gradiente di chi2
51 pam-fi 1.4
52     c elena--------
53     REAL*8 AVRESX,AVRESY
54     c elena--------
55    
56 mocchiut 1.1 INTEGER IFLAG
57     c--------------------------------------------------------
58     c IFLAG =1 ---- chi2 derivatives computed by using
59     c incremental ratios and posxyz.f
60     c IFLAG =2 ---- the approximation of Golden is used
61     c (see chisq.f)
62     c
63     c NB: the two metods gives equivalent results BUT
64     c method 2 is faster!!
65     c--------------------------------------------------------
66 pam-fi 1.3 DATA IFLAG/2/
67    
68 pam-fi 1.4 c LOGICAL TRKDEBUG,TRKVERBOSE
69     c COMMON/TRKD/TRKDEBUG,TRKVERBOSE
70 pam-fi 1.18 LOGICAL TRKDEBUG,TRKVERBOSE,STUDENT,FIRSTSTEPS,FIRSTSTUDENT
71 pam-fi 1.4 COMMON/TRKD/TRKDEBUG,TRKVERBOSE
72 pam-fi 1.3
73 pam-fi 1.17 DIMENSION AL0(5)
74     LOGICAL SUCCESS_NEW,SUCCESS_OLD
75     *
76     * define kind of minimization (0x=chi2+gaussian or 1x=likelihood+student)
77     *
78     STUDENT = .false.
79 pam-fi 1.18 FIRSTSTEPS = .true.
80     FIRSTSTUDENT = .true.
81 pam-fi 1.17 IF(MOD(INT(TRACKMODE/10),10).EQ.1) STUDENT = .true.
82    
83 pam-fi 1.3 IF(IPRINT.EQ.1) THEN
84 pam-fi 1.4 TRKVERBOSE = .TRUE.
85     TRKDEBUG = .FALSE.
86     ELSEIF(IPRINT.EQ.2)THEN
87     TRKVERBOSE = .TRUE.
88     TRKDEBUG = .TRUE.
89 pam-fi 1.3 ELSE
90 pam-fi 1.4 TRKVERBOSE = .FALSE.
91     TRKDEBUG = .FALSE.
92 pam-fi 1.3 ENDIF
93 mocchiut 1.1
94     * ----------------------------------------------------------
95 pam-fi 1.4 * evaluate average spatial resolution
96     * ----------------------------------------------------------
97     AVRESX = RESXAV
98     AVRESY = RESYAV
99     DO IP=1,6
100     IF( XGOOD(IP).EQ.1 )THEN
101     NX=NX+1
102     AVRESX=AVRESX+RESX(IP)
103     ENDIF
104     IF(NX.NE.0)AVRESX=AVRESX/NX
105     IF( YGOOD(IP).EQ.1 )THEN
106     NY=NY+1
107     AVRESY=AVRESY+RESY(IP)
108     ENDIF
109     IF(NX.NE.0)AVRESY=AVRESY/NY
110     ENDDO
111    
112     * ----------------------------------------------------------
113 mocchiut 1.1 * define ALTOL(5) ---> tolerances on state vector
114     *
115     * ----------------------------------------------------------
116 pam-fi 1.4 * changed in order to evaluate energy-dependent
117     * tolerances on all 5 parameters
118 pam-fi 1.14 cPP FACT=1.0e10 !scale factor to define tolerance on alfa
119 mocchiut 1.1 c deflection error (see PDG)
120 pam-fi 1.4 DELETA1 = 0.01/0.3/0.4/0.4451**2*SQRT(720./(6.+4.))
121     DELETA2 = 0.016/0.3/0.4/0.4451*SQRT(0.4451/9.36)
122     c$$$ ALTOL(1) = AVRESX/FACT !al(1) = x
123     c$$$ ALTOL(2) = AVRESY/FACT !al(2) = y
124     c$$$ ALTOL(3) = DSQRT(AVRESX**2 !al(3)=sin(theta)
125     c$$$ $ +AVRESY**2)/44.51/FACT
126     c$$$ ALTOL(4) = ALTOL(3) !al(4)=phi
127     c deflection error (see PDG)
128     c$$$ DELETA1 = 0.01*AVRESX/0.3/0.4/0.4451**2*SQRT(720./(6.+4.))
129     c$$$ DELETA2 = 0.016/0.3/0.4/0.4451*SQRT(0.4451/9.36)
130 mocchiut 1.1 * ----------------------------------------------------------
131     *
132     ISTEP=0 !num. steps to minimize chi^2
133     JFAIL=0 !error flag
134 pam-fi 1.12 CHI2=0
135 pam-fi 1.4
136 pam-fi 1.5 if(TRKDEBUG) print*,'guess: ',al
137 pam-fi 1.4 if(TRKDEBUG) print*,'mini2: step ',istep,chi2,1./AL(5)
138    
139 pam-fi 1.3 *
140     * -----------------------
141     * START MINIMIZATION LOOP
142     * -----------------------
143     10 ISTEP=ISTEP+1 !<<<<<<<<<<<<<< NEW STEP !!
144    
145 pam-fi 1.17 * -------------------------------
146     * **** Chi2+gaussian minimization
147     * -------------------------------
148    
149 pam-fi 1.18 IF(.NOT.STUDENT.OR.FIRSTSTEPS) THEN
150    
151     IF(ISTEP.GE.3) FIRSTSTEPS = .false.
152 pam-fi 1.17
153     CALL CHISQ(IFLAG,JFAIL) !chi^2 and its derivatives
154     IF(JFAIL.NE.0) THEN
155     IFAIL=1
156     CHI2=-9999.
157     if(TRKVERBOSE)
158     $ PRINT *,'*** ERROR in mini *** wrong CHISQ'
159     RETURN
160     ENDIF
161    
162     c COST=1e-5
163     COST=1.
164     DO I=1,5
165     IF(CHI2DD(I,I).NE.0.)COST=COST/DABS(CHI2DD(I,I))**0.2
166     ENDDO
167     DO I=1,5
168     DO J=1,5
169     CHI2DD(I,J)=CHI2DD(I,J)*COST
170     ENDDO
171     c$$$ CHI2D(I)=CHI2D(I)*COST
172 mocchiut 1.1 ENDDO
173 pam-fi 1.3
174 pam-fi 1.17 IF(PFIXED.EQ.0.) THEN
175 pam-fi 1.3
176 mocchiut 1.1 *------------------------------------------------------------*
177     * track fitting with FREE deflection
178     *------------------------------------------------------------*
179 pam-fi 1.17 CALL DSFACT(5,CHI2DD,5,IFA,DET,JFA) !CHI2DD matrix determinant
180     IF(IFA.NE.0) THEN !not positive-defined
181     if(TRKVERBOSE)then
182     PRINT *,
183     $ '*** ERROR in mini ***'//
184     $ 'on matrix inversion (not pos-def)'
185     $ ,DET
186     endif
187     IF(CHI2.EQ.0) CHI2=-9999.
188     IF(CHI2.GT.0) CHI2=-CHI2
189     IFAIL=1
190     RETURN
191     ENDIF
192     CALL DSFINV(5,CHI2DD,5) !CHI2DD matrix inversion
193 pam-fi 1.3 * *******************************************
194     * find new value of AL-pha
195 pam-fi 1.4 * *******************************************
196 pam-fi 1.17 DO I=1,5
197     DAL(I)=0.
198     DO J=1,5
199     DAL(I)=DAL(I)-CHI2DD(I,J)*CHI2D(J) *COST
200     COV(I,J)=2.*COST*CHI2DD(I,J)
201     ENDDO
202     ENDDO
203     DO I=1,5
204     AL(I)=AL(I)+DAL(I)
205     ENDDO
206 pam-fi 1.3 *------------------------------------------------------------*
207     * track fitting with FIXED deflection
208     *------------------------------------------------------------*
209 pam-fi 1.17 ELSE
210     AL(5)=1./PFIXED
211     DO I=1,4
212     CHI2D_R(I)=CHI2D(I)
213     DO J=1,4
214     CHI2DD_R(I,J)=CHI2DD(I,J)
215     ENDDO
216 pam-fi 1.3 ENDDO
217 pam-fi 1.17 CALL DSFACT(4,CHI2DD_R,4,IFA,DET,JFA)
218     IF(IFA.NE.0) THEN
219     if(TRKVERBOSE)then
220     PRINT *,
221     $ '*** ERROR in mini ***'//
222     $ 'on matrix inversion (not pos-def)'
223     $ ,DET
224     endif
225     IF(CHI2.EQ.0) CHI2=-9999.
226     IF(CHI2.GT.0) CHI2=-CHI2
227     IFAIL=1
228     RETURN
229     ENDIF
230     CALL DSFINV(4,CHI2DD_R,4)
231 pam-fi 1.4 * *******************************************
232     * find new value of AL-pha
233     * *******************************************
234 pam-fi 1.17 DO I=1,4
235     DAL(I)=0.
236     DO J=1,4
237     DAL(I)=DAL(I)-CHI2DD_R(I,J)*CHI2D_R(J) *COST
238     COV(I,J)=2.*COST*CHI2DD_R(I,J)
239     ENDDO
240     ENDDO
241     DAL(5)=0.
242     DO I=1,4
243     AL(I)=AL(I)+DAL(I)
244 pam-fi 1.3 ENDDO
245 pam-fi 1.17 ENDIF
246    
247     if(TRKDEBUG) print*,'mini2: step ',istep,chi2,1./AL(5)
248    
249     c$$$ PRINT*,'DAL ',(DAL(K),K=1,5)
250     c$$$ PRINT*,'CHI2DOLD ',(CHI2DOLD(K),K=1,5)
251    
252    
253     ENDIF
254    
255     * -------------------------------
256     * **** Likelihood+Student minimization
257     * -------------------------------
258    
259 pam-fi 1.18 IF(STUDENT.AND.(.NOT.FIRSTSTEPS)) THEN
260    
261     IF(FIRSTSTUDENT) THEN
262     FIRSTSTUDENT = .false.
263     ISTEP = 1
264     ENDIF
265    
266 pam-fi 1.17 CALL CHISQSTT(1,JFAIL)
267     DO I=1,5
268     DAL(I)=0.
269     DO J=1,5
270     DAL(I)=DAL(I)-CHI2DD(I,J)*CHI2D(J)
271     ENDDO
272     ENDDO
273    
274     DO I=1,5
275     DO j=1,5
276     COV(I,J) = 2.*CHI2DD(I,J)
277     ENDDO
278     ENDDO
279    
280     CHI2TOLL = 1.E-3
281     ALPHA = 3.0
282     BETA = -0.4
283     E=1.
284     EA=1.
285     EB=1.
286     EC=1.
287     FA=1.
288     FB=1.
289     FC=1.
290     SUCCESS_OLD = .FALSE.
291     SUCCESS_NEW = .FALSE.
292    
293     CALL CHISQSTT(0,JFAIL)
294     c$$$ PRINT*,CHI2
295     CHI2_NEW = CHI2
296     FC = CHI2
297     EC = 0.
298    
299     100 CONTINUE
300     DO I=1,5
301     AL0(I)=AL(I)
302     ENDDO
303     DO I=1,5
304     AL(I)=AL(I)+E*DAL(I)
305 pam-fi 1.3 ENDDO
306 pam-fi 1.17 CALL CHISQSTT(0,JFAIL)
307     CHI2_OLD = CHI2_NEW
308     CHI2_NEW = CHI2
309     FA = FB
310     FB = FC
311     FC = CHI2
312     EA = EB
313     EB = EC
314     EC = E
315    
316     c$$$ PRINT*,E,CHI2_NEW
317    
318     IF(CHI2_NEW.LE.CHI2_OLD) THEN ! success
319     IF(DABS(CHI2_NEW-CHI2_OLD).LT.CHI2TOLL) GOTO 101
320     SUCCESS_OLD = SUCCESS_NEW
321     SUCCESS_NEW = .TRUE.
322     E = E*ALPHA
323     ELSE ! failure
324     SUCCESS_OLD = SUCCESS_NEW
325     SUCCESS_NEW = .FALSE.
326     CHI2_NEW = CHI2_OLD
327     DO I=1,5
328     AL(I)=AL0(I)
329     ENDDO
330     IF(SUCCESS_OLD) THEN
331     DENOM = (EB-EA)*(FB-FC) - (EB-EC)*(FB-FA)
332     IF(DENOM.NE.0.) THEN
333     E = EB - 0.5*( (EB-EA)**2*(FB-FC)
334     $ - (EB-EC)**2*(FB-FA) ) / DENOM
335     ELSE
336     E = BETA*E
337     ENDIF
338     ELSE
339     E = BETA*E
340     ENDIF
341     c$$$ E = BETA*E
342     ENDIF
343     GOTO 100
344    
345     101 CONTINUE
346    
347     DO I=1,5
348     DAL(I)=E*DAL(I)
349 pam-fi 1.3 ENDDO
350 pam-fi 1.17
351     c$$$ print*,' '
352     c$$$ PRINT*,'DAL ',(DAL(K),K=1,5)
353     c$$$ PRINT*,'CHI2DOLD ',(CHI2DOLD(K),K=1,5)
354     c$$$ print*,'==== CHI2 ===='
355     c$$$ print*,chi2
356     c$$$ print*,'==== CHI2d ===='
357     c$$$ print*,(chi2d(i),i=1,5)
358     c$$$ print*,'==== CHI2dd ===='
359     c$$$ do j=1,5
360     c$$$ print*,(chi2dd(j,i),i=1,5)
361     c$$$ enddo
362     c$$$ print*,'================'
363     c$$$ print*,' '
364    
365     *========= FIN QUI =============
366    
367 mocchiut 1.1 ENDIF
368 pam-fi 1.4
369 pam-fi 1.17
370    
371    
372 pam-fi 1.4
373 pam-fi 1.3 *------------------------------------------------------------*
374     * ---------------------------------------------------- *
375     *------------------------------------------------------------*
376 mocchiut 1.1 * check parameter bounds:
377 pam-fi 1.4 *------------------------------------------------------------*
378 mocchiut 1.1 DO I=1,5
379     IF(AL(I).GT.ALMAX(I).OR.AL(I).LT.ALMIN(I))THEN
380 pam-fi 1.4 if(TRKVERBOSE)then
381 pam-fi 1.3 PRINT*,' *** WARNING in mini *** '
382 mocchiut 1.1 PRINT*,'MINI_2 ==> AL(',I,') out of range'
383     PRINT*,' value: ',AL(I),
384     $ ' limits: ',ALMIN(I),ALMAX(I)
385     print*,'istep ',istep
386     endif
387 pam-fi 1.3 IF(CHI2.EQ.0) CHI2=-9999.
388     IF(CHI2.GT.0) CHI2=-CHI2
389 mocchiut 1.1 IFAIL=1
390     RETURN
391     ENDIF
392     ENDDO
393 pam-fi 1.4 *------------------------------------------------------------*
394 mocchiut 1.1 * check number of steps:
395 pam-fi 1.4 *------------------------------------------------------------*
396     IF(ISTEP.ge.ISTEPMAX) then
397 pam-fi 1.7 c$$$ IFAIL=1
398     c$$$ if(TRKVERBOSE)
399     c$$$ $ PRINT *,'*** WARNING in mini *** ISTEP.GT.ISTEPMAX=',
400     c$$$ $ ISTEPMAX
401 mocchiut 1.1 goto 11
402     endif
403 pam-fi 1.4 *------------------------------------------------------------*
404 mocchiut 1.1 * ---------------------------------------------
405     * evaluate deflection tolerance on the basis of
406     * estimated deflection
407     * ---------------------------------------------
408 pam-fi 1.4 *------------------------------------------------------------*
409     c$$$ ALTOL(5) = DSQRT(DELETA1**2+DELETA2**2*AL(5)**2)/FACT
410     ALTOL(5) = DSQRT((DELETA1*AVRESX)**2+DELETA2**2*AL(5)**2)/FACT
411     ALTOL(1) = ALTOL(5)/DELETA1
412     ALTOL(2) = ALTOL(1)
413     ALTOL(3) = DSQRT(ALTOL(1)**2+ALTOL(2)**2)/44.51
414     ALTOL(4) = ALTOL(3)
415    
416 pam-fi 1.14 c$$$ print*,' -- ',(DAL(I),ALTOL(I),' - ',i=1,5) !>>>> new step!
417    
418 mocchiut 1.1 *---- check tolerances:
419 pam-fi 1.4 c$$$ DO I=1,5
420     c$$$ if(TRKVERBOSE)print*,i,' -- ',DAL(I),ALTOL(I) !>>>> new step!
421     c$$$ ENDDO
422     c$$$ print*,'chi2 -- ',DCHI2
423    
424 pam-fi 1.14 IF(ISTEP.LT.ISTEPMIN) GOTO 10 ! ***PP***
425 mocchiut 1.1 DO I=1,5
426     IF(ABS(DAL(I)).GT.ALTOL(I))GOTO 10 !>>>> new step!
427     ENDDO
428    
429 pam-fi 1.17 *****************************
430     * final estimate of chi^2
431     *****************************
432    
433     * -------------------------------
434     * **** Chi2+gaussian minimization
435     * -------------------------------
436    
437     IF(.NOT.STUDENT) THEN
438    
439     JFAIL=0 !error flag
440     CALL CHISQ(IFLAG,JFAIL) !chi^2 and its derivatives
441     IF(JFAIL.NE.0) THEN
442     IFAIL=1
443     if(TRKVERBOSE)THEN
444     CHI2=-9999.
445     if(TRKVERBOSE)
446     $ PRINT *,'*** ERROR in mini *** wrong CHISQ'
447     ENDIF
448     RETURN
449 pam-fi 1.3 ENDIF
450 pam-fi 1.17 c COST=1e-7
451     COST=1.
452     DO I=1,5
453     IF(CHI2DD(I,I).NE.0.)COST=COST/DABS(CHI2DD(I,I))**0.2
454 pam-fi 1.3 ENDDO
455 pam-fi 1.17 DO I=1,5
456     DO J=1,5
457     CHI2DD(I,J)=CHI2DD(I,J)*COST
458 pam-fi 1.3 ENDDO
459     ENDDO
460 pam-fi 1.17 IF(PFIXED.EQ.0.) THEN
461     CALL DSFACT(5,CHI2DD,5,IFA,DET,JFA) !CHI2DD matrix determinant
462     IF(IFA.NE.0) THEN !not positive-defined
463     if(TRKVERBOSE)then
464     PRINT *,
465     $ '*** ERROR in mini ***'//
466     $ 'on matrix inversion (not pos-def)'
467     $ ,DET
468     endif
469     IF(CHI2.EQ.0) CHI2=-9999.
470     IF(CHI2.GT.0) CHI2=-CHI2
471     IFAIL=1
472     RETURN
473     ENDIF
474     CALL DSFINV(5,CHI2DD,5) !CHI2DD matrix inversion
475     DO I=1,5
476     c$$$ DAL(I)=0.
477     DO J=1,5
478     COV(I,J)=2.*COST*CHI2DD(I,J)
479     ENDDO
480     ENDDO
481     ELSE
482     DO I=1,4
483     CHI2D_R(I)=CHI2D(I)
484     DO J=1,4
485     CHI2DD_R(I,J)=CHI2DD(I,J)
486     ENDDO
487     ENDDO
488     CALL DSFACT(4,CHI2DD_R,4,IFA,DET,JFA)
489     IF(IFA.NE.0) THEN
490     if(TRKVERBOSE)then
491     PRINT *,
492     $ '*** ERROR in mini ***'//
493     $ 'on matrix inversion (not pos-def)'
494     $ ,DET
495     endif
496     IF(CHI2.EQ.0) CHI2=-9999.
497     IF(CHI2.GT.0) CHI2=-CHI2
498     IFAIL=1
499     RETURN
500     ENDIF
501     CALL DSFINV(4,CHI2DD_R,4)
502     DO I=1,4
503     c$$$ DAL(I)=0.
504     DO J=1,4
505     COV(I,J)=2.*COST*CHI2DD_R(I,J)
506     ENDDO
507     ENDDO
508 pam-fi 1.3 ENDIF
509 pam-fi 1.17
510     ENDIF
511    
512     * -------------------------------
513     * **** Likelihood+student minimization
514     * -------------------------------
515    
516     IF(STUDENT) THEN
517     CALL CHISQSTT(1,JFAIL)
518     DO I=1,5
519     DO j=1,5
520     COV(I,J) = 2.*CHI2DD(I,J)
521 pam-fi 1.3 ENDDO
522     ENDDO
523     ENDIF
524 pam-fi 1.17
525 pam-fi 1.3 *****************************
526 mocchiut 1.1
527     * ------------------------------------
528     * Number of Degree Of Freedom
529     ndof=0
530     do ip=1,nplanes
531     ndof=ndof
532     $ +int(xgood(ip))
533     $ +int(ygood(ip))
534     enddo
535 pam-fi 1.3 if(pfixed.eq.0.) ndof=ndof-5 ! ***PP***
536     if(pfixed.ne.0.) ndof=ndof-4 ! ***PP***
537     if(ndof.le.0.) then
538     ndof = 1
539 pam-fi 1.4 if(TRKVERBOSE)
540 pam-fi 1.3 $ print*,'*** WARNING *** in mini n.dof = 0 (set to 1)'
541     endif
542 pam-fi 1.4
543 mocchiut 1.1 * ------------------------------------
544     * Reduced chi^2
545     CHI2 = CHI2/dble(ndof)
546    
547 pam-fi 1.4 c print*,'mini2: chi2 ',chi2
548    
549 mocchiut 1.1 11 CONTINUE
550    
551 pam-fi 1.14 if(TRKDEBUG) print*,'mini2: -ok- ',istep,chi2,1./AL(5)
552    
553 pam-fi 1.3 NSTEP=ISTEP ! ***PP***
554 mocchiut 1.1
555 pam-fi 1.14 c$$$ print*,'>>>>> NSTEP = ',NSTEP
556    
557 mocchiut 1.1 RETURN
558     END
559    
560     ******************************************************************************
561     *
562     * routine to compute chi^2 and its derivatives
563     *
564     *
565     * (modified in respect to the previous one in order to include
566     * single clusters. In this case the residual is evaluated by
567     * calculating the distance between the track intersection and the
568     * segment AB associated to the single cluster)
569     *
570     ******************************************************************************
571    
572     SUBROUTINE CHISQ(IFLAG,IFAIL)
573    
574     IMPLICIT DOUBLE PRECISION (A-H,O-Z)
575    
576     include 'commontracker.f' !tracker general common
577     include 'common_mini_2.f' !common for the tracking procedure
578    
579     DIMENSION XV2(nplanes),YV2(nplanes),XV1(nplanes),YV1(nplanes)
580     $ ,XV0(nplanes),YV0(nplanes)
581     DIMENSION AL_P(5)
582 pam-fi 1.3
583 pam-fi 1.4 c LOGICAL TRKVERBOSE
584     c COMMON/TRKD/TRKVERBOSE
585     LOGICAL TRKDEBUG,TRKVERBOSE
586     COMMON/TRKD/TRKDEBUG,TRKVERBOSE
587 mocchiut 1.1 *
588     * chi^2 computation
589     *
590     DO I=1,5
591     AL_P(I)=AL(I)
592     ENDDO
593     JFAIL=0 !error flag
594     CALL POSXYZ(AL_P,JFAIL) !track intersection with tracking planes
595     IF(JFAIL.NE.0) THEN
596 pam-fi 1.4 IF(TRKVERBOSE)
597 pam-fi 1.3 $ PRINT *,'CHISQ ==> error from trk routine POSXYZ !!'
598 mocchiut 1.1 IFAIL=1
599     RETURN
600     ENDIF
601     DO I=1,nplanes
602     XV0(I)=XV(I)
603     YV0(I)=YV(I)
604     ENDDO
605     * ------------------------------------------------
606     c$$$ CHI2=0.
607     c$$$ DO I=1,nplanes
608     c$$$ CHI2=CHI2
609     c$$$ + +(XV(I)-XM(I))**2/RESX(i)**2 *XGOOD(I)*YGOOD(I)
610     c$$$ + +(YV(I)-YM(I))**2/RESY(i)**2 *YGOOD(I)*XGOOD(I)
611     c$$$ ENDDO
612     * ---------------------------------------------------------
613     * For planes with only a X or Y-cl included, instead of
614     * a X-Y couple, the residual for chi^2 calculation is
615     * evaluated by finding the point x-y, along the segment AB,
616     * closest to the track.
617     * The X or Y coordinate, respectivelly for X and Y-cl, is
618     * then assigned to XM or YM, which is then considered the
619     * measured position of the cluster.
620     * ---------------------------------------------------------
621     CHI2=0.
622 pam-fi 1.16 DO I=1,nplanes
623 mocchiut 1.1 IF(XGOOD(I).EQ.1.AND.YGOOD(I).EQ.0)THEN !X-cl
624     BETA = (XM_B(I)-XM_A(I))/(YM_B(I)-YM_A(I))
625     ALFA = XM_A(I) - BETA * YM_A(I)
626     YM(I) = ( YV(I) + BETA*XV(I) - BETA*ALFA )/(1+BETA**2)
627     if(YM(I).lt.dmin1(YM_A(I),YM_B(I)))
628     $ YM(I)=dmin1(YM_A(I),YM_B(I))
629     if(YM(I).gt.dmax1(YM_A(I),YM_B(I)))
630     $ YM(I)=dmax1(YM_A(I),YM_B(I))
631     XM(I) = ALFA + BETA * YM(I) !<<<< measured coordinates
632     ELSEIF(XGOOD(I).EQ.0.AND.YGOOD(I).EQ.1)THEN !Y-cl
633     BETA = (YM_B(I)-YM_A(I))/(XM_B(I)-XM_A(I))
634     ALFA = YM_A(I) - BETA * XM_A(I)
635     XM(I) = ( XV(I) + BETA*YV(I) - BETA*ALFA )/(1+BETA**2)
636     if(XM(I).lt.dmin1(XM_A(I),XM_B(I)))
637     $ XM(I)=dmin1(XM_A(I),XM_B(I))
638     if(XM(I).gt.dmax1(XM_A(I),XM_B(I)))
639     $ XM(I)=dmax1(XM_A(I),XM_B(I))
640     YM(I) = ALFA + BETA * XM(I) !<<<< measured coordinates
641     ENDIF
642     CHI2=CHI2
643     + +(XV(I)-XM(I))**2/RESX(i)**2 *( XGOOD(I)*YGOOD(I) )
644     + +(YV(I)-YM(I))**2/RESY(i)**2 *( YGOOD(I)*XGOOD(I) )
645     + +((XV(I)-XM(I))**2+(YV(I)-YM(I))**2)/RESX(i)**2
646     + *( XGOOD(I)*(1-YGOOD(I)) )
647     + +((XV(I)-XM(I))**2+(YV(I)-YM(I))**2)/RESY(i)**2
648     + *( (1-XGOOD(I))*YGOOD(I) )
649 pam-fi 1.10 c$$$ print*,(XV(I)-XM(I))**2/RESX(i)**2 *( XGOOD(I)*YGOOD(I) )
650     c$$$ print*,(YV(I)-YM(I))**2/RESY(i)**2 *( YGOOD(I)*XGOOD(I) )
651     c$$$ print*,((XV(I)-XM(I))**2+(YV(I)-YM(I))**2)/RESX(i)**2
652     c$$$ + *( XGOOD(I)*(1-YGOOD(I)) )
653     c$$$ print*,((XV(I)-XM(I))**2+(YV(I)-YM(I))**2)/RESY(i)**2
654     c$$$ + *( (1-XGOOD(I))*YGOOD(I) )
655     c$$$ print*,XV(I),XM(I),XGOOD(I)
656     c$$$ print*,YV(I),YM(I),YGOOD(I)
657 mocchiut 1.1 ENDDO
658 pam-fi 1.10 c$$$ print*,'CHISQ ',chi2
659 mocchiut 1.1 * ------------------------------------------------
660     *
661     * calculation of derivatives (dX/dAL_fa and dY/dAL_fa)
662     *
663     * //////////////////////////////////////////////////
664     * METHOD 1 -- incremental ratios
665     * //////////////////////////////////////////////////
666    
667     IF(IFLAG.EQ.1) THEN
668    
669     DO J=1,5
670     DO JJ=1,5
671     AL_P(JJ)=AL(JJ)
672     ENDDO
673     AL_P(J)=AL_P(J)+STEPAL(J)/2.
674     JFAIL=0
675     CALL POSXYZ(AL_P,JFAIL)
676     IF(JFAIL.NE.0) THEN
677 pam-fi 1.4 IF(TRKVERBOSE)
678 pam-fi 1.3 *23456789012345678901234567890123456789012345678901234567890123456789012
679     $ PRINT *,'CHISQ ==> error from trk routine POSXYZ'
680 mocchiut 1.1 IFAIL=1
681     RETURN
682     ENDIF
683     DO I=1,nplanes
684     XV2(I)=XV(I)
685     YV2(I)=YV(I)
686     ENDDO
687     AL_P(J)=AL_P(J)-STEPAL(J)
688     JFAIL=0
689     CALL POSXYZ(AL_P,JFAIL)
690     IF(JFAIL.NE.0) THEN
691 pam-fi 1.4 IF(TRKVERBOSE)
692 pam-fi 1.3 $ PRINT *,'CHISQ ==> error from trk routine POSXYZ'
693 mocchiut 1.1 IFAIL=1
694     RETURN
695     ENDIF
696     DO I=1,nplanes
697     XV1(I)=XV(I)
698     YV1(I)=YV(I)
699     ENDDO
700     DO I=1,nplanes
701     DXDAL(I,J)=(XV2(I)-XV1(I))/STEPAL(J)
702     DYDAL(I,J)=(YV2(I)-YV1(I))/STEPAL(J)
703     ENDDO
704     ENDDO
705    
706     ENDIF
707    
708     * //////////////////////////////////////////////////
709     * METHOD 2 -- Bob Golden
710     * //////////////////////////////////////////////////
711    
712     IF(IFLAG.EQ.2) THEN
713    
714     DO I=1,nplanes
715     DXDAL(I,1)=1.
716     DYDAL(I,1)=0.
717    
718     DXDAL(I,2)=0.
719     DYDAL(I,2)=1.
720    
721     COSTHE=DSQRT(1.-AL(3)**2)
722     IF(COSTHE.EQ.0.) THEN
723 pam-fi 1.4 IF(TRKVERBOSE)PRINT *,'=== WARNING ===> COSTHE=0'
724 pam-fi 1.3 IFAIL=1
725     RETURN
726 mocchiut 1.1 ENDIF
727    
728     DXDAL(I,3)=(ZINI-ZM(I))*DCOS(AL(4))/COSTHE**3
729     DYDAL(I,3)=(ZINI-ZM(I))*DSIN(AL(4))/COSTHE**3
730    
731     DXDAL(I,4)=-AL(3)*(ZINI-ZM(I))*DSIN(AL(4))/COSTHE
732     DYDAL(I,4)=AL(3)*(ZINI-ZM(I))*DCOS(AL(4))/COSTHE
733    
734     IF(AL(5).NE.0.) THEN
735     DXDAL(I,5)=
736     + (XV(I)-(AL(1)+AL(3)/COSTHE*(ZINI-ZM(I))
737     + *DCOS(AL(4))))/AL(5)
738     DYDAL(I,5)=
739     + (YV(I)-(AL(2)+AL(3)/COSTHE*(ZINI-ZM(I))
740     + *DSIN(AL(4))))/AL(5)
741     ELSE
742     DXDAL(I,5)=100.*( 0.25 *0.3*0.4*(0.01*(ZINI-ZM(I)))**2 )
743     DYDAL(I,5)=0.
744     ENDIF
745    
746     ENDDO
747     ENDIF
748     *
749     * x-x-x-x-x-x-x-x-x-x-x-x-x-x-x-x-x-x-x-x-x-x-x-x-x-x-x-x-x-x-x-x-x
750     * >>> CHI2D evaluation
751     *
752     DO J=1,5
753     CHI2D(J)=0.
754     DO I=1,nplanes
755     CHI2D(J)=CHI2D(J)
756     + +2.*(XV0(I)-XM(I))/RESX(i)**2*DXDAL(I,J) *XGOOD(I)
757     + +2.*(YV0(I)-YM(I))/RESY(i)**2*DYDAL(I,J) *YGOOD(I)
758     ENDDO
759     ENDDO
760     *
761     * >>> CHI2DD evaluation
762     *
763     DO I=1,5
764     DO J=1,5
765     CHI2DD(I,J)=0.
766     DO K=1,nplanes
767     CHI2DD(I,J)=CHI2DD(I,J)
768     + +2.*DXDAL(K,I)*DXDAL(K,J)/RESX(k)**2 *XGOOD(K)
769     + +2.*DYDAL(K,I)*DYDAL(K,J)/RESY(k)**2 *YGOOD(K)
770     ENDDO
771     ENDDO
772     ENDDO
773     * x-x-x-x-x-x-x-x-x-x-x-x-x-x-x-x-x-x-x-x-x-x-x-x-x-x-x-x-x-x-x-x-x
774    
775     RETURN
776     END
777    
778 pam-fi 1.17 ******************************************************************************
779     *
780     * routine to compute Likelihodd+Student and its derivatives
781     *
782     * (modified in respect to the previous one in order to include
783     * single clusters. In this case the residual is evaluated by
784     * calculating the distance between the track intersection and the
785     * segment AB associated to the single cluster)
786     *
787     ******************************************************************************
788    
789     SUBROUTINE CHISQSTT(IFLAG,JFAIL)
790    
791     IMPLICIT DOUBLE PRECISION (A-H,O-Z)
792    
793     include 'commontracker.f' !tracker general common
794     include 'common_mini_2.f' !common for the tracking procedure
795    
796     LOGICAL TRKDEBUG,TRKVERBOSE
797     COMMON/TRKD/TRKDEBUG,TRKVERBOSE
798    
799     DIMENSION AL_P(5)
800     DIMENSION VECTEMP(5)
801     c$$$ DIMENSION U(5) ! BFGS
802    
803     DO I=1,5
804     AL_P(I)=AL(I)
805     ENDDO
806     JFAIL=0 !error flag
807     CALL POSXYZ(AL_P,JFAIL) !track intersection with tracking planes
808     IF(JFAIL.NE.0) THEN
809     IF(TRKVERBOSE)
810     $ PRINT *,'CHISQSTT ==> error from trk routine POSXYZ !!'
811     IFAIL=1
812     RETURN
813     ENDIF
814    
815     DO I=1,nplanes
816     DXDAL(I,1)=1.
817     DYDAL(I,1)=0.
818     DXDAL(I,2)=0.
819     DYDAL(I,2)=1.
820     COSTHE=DSQRT(1.-AL(3)**2)
821     IF(COSTHE.EQ.0.) THEN
822     IF(TRKVERBOSE)PRINT *,'=== WARNING ===> COSTHE=0'
823     IFAIL=1
824     RETURN
825     ENDIF
826     DXDAL(I,3)=(ZINI-ZM(I))*DCOS(AL(4))/COSTHE**3
827     DYDAL(I,3)=(ZINI-ZM(I))*DSIN(AL(4))/COSTHE**3
828     DXDAL(I,4)=-AL(3)*(ZINI-ZM(I))*DSIN(AL(4))/COSTHE
829     DYDAL(I,4)=AL(3)*(ZINI-ZM(I))*DCOS(AL(4))/COSTHE
830     IF(AL(5).NE.0.) THEN
831     DXDAL(I,5)=
832     + (XV(I)-(AL(1)+AL(3)/COSTHE*(ZINI-ZM(I))
833     + *DCOS(AL(4))))/AL(5)
834     DYDAL(I,5)=
835     + (YV(I)-(AL(2)+AL(3)/COSTHE*(ZINI-ZM(I))
836     + *DSIN(AL(4))))/AL(5)
837     ELSE
838     DXDAL(I,5)=100.*( 0.25 *0.3*0.4*(0.01*(ZINI-ZM(I)))**2 )
839     DYDAL(I,5)=0.
840     ENDIF
841     ENDDO
842    
843     IF(IFLAG.EQ.0) THEN ! function calulation
844     CHI2=0.
845     DO I=1,nplanes
846     IF(XGOOD(I).EQ.1.AND.YGOOD(I).EQ.0)THEN !X-cl
847     BETA = (XM_B(I)-XM_A(I))/(YM_B(I)-YM_A(I))
848     ALFA = XM_A(I) - BETA * YM_A(I)
849     YM(I) = ( YV(I) + BETA*XV(I) - BETA*ALFA )/(1+BETA**2)
850     if(YM(I).lt.dmin1(YM_A(I),YM_B(I)))
851     $ YM(I)=dmin1(YM_A(I),YM_B(I))
852     if(YM(I).gt.dmax1(YM_A(I),YM_B(I)))
853     $ YM(I)=dmax1(YM_A(I),YM_B(I))
854     XM(I) = ALFA + BETA * YM(I) !<<<< measured coordinates
855     ELSEIF(XGOOD(I).EQ.0.AND.YGOOD(I).EQ.1)THEN !Y-cl
856     BETA = (YM_B(I)-YM_A(I))/(XM_B(I)-XM_A(I))
857     ALFA = YM_A(I) - BETA * XM_A(I)
858     XM(I) = ( XV(I) + BETA*YV(I) - BETA*ALFA )/(1+BETA**2)
859     if(XM(I).lt.dmin1(XM_A(I),XM_B(I)))
860     $ XM(I)=dmin1(XM_A(I),XM_B(I))
861     if(XM(I).gt.dmax1(XM_A(I),XM_B(I)))
862     $ XM(I)=dmax1(XM_A(I),XM_B(I))
863     YM(I) = ALFA + BETA * XM(I) !<<<< measured coordinates
864     ENDIF
865     TERMX = DLOG( (TAILX(I)*RESX(I)**2+(XV(I)-XM(I))**2)/
866     $ (TAILX(I)*RESX(I)**2) )
867     TERMY = DLOG( (TAILY(I)*RESY(I)**2+(YV(I)-YM(I))**2)/
868     $ (TAILY(I)*RESY(I)**2) )
869     CHI2=CHI2
870     $ +(TAILX(I)+1.0)*TERMX *( XGOOD(I) )
871     $ +(TAILY(I)+1.0)*TERMY *( YGOOD(I) )
872     ENDDO
873     ENDIF
874    
875     IF(IFLAG.EQ.1) THEN ! derivative calulation
876     DO I=1,5
877     CHI2DOLD(I)=CHI2D(I)
878     ENDDO
879     DO J=1,5
880     CHI2D(J)=0.
881     DO I=1,nplanes
882     CHI2D(J)=CHI2D(J)
883     $ +2.*(TAILX(I)+1.0)*(XV(I)-XM(I))/
884     $ (TAILX(I)*RESX(I)**2+(XV(I)-XM(I))**2)*
885     $ DXDAL(I,J) *XGOOD(I)
886     $ +2.*(TAILY(I)+1.0)*(YV(I)-YM(I))/
887     $ (TAILY(I)*RESY(I)**2+(YV(I)-YM(I))**2)*
888     $ DYDAL(I,J) *YGOOD(I)
889     ENDDO
890     ENDDO
891     DO K=1,5
892     VECTEMP(K)=0.
893     DO M=1,5
894     VECTEMP(K) = VECTEMP(K) +
895     $ COV(K,M)/2.*(CHI2D(M)-CHI2DOLD(M))
896     ENDDO
897     ENDDO
898     DOWN1 = 0.
899     DO K=1,5
900     DOWN1 = DOWN1 + DAL(K)*(CHI2D(K)-CHI2DOLD(K))
901     ENDDO
902     IF(DOWN1.EQ.0.) THEN
903     PRINT*,'WARNING IN MATRIX CALULATION (STUDENT), DOWN1 = 0'
904     IFAIL=1
905     RETURN
906     ENDIF
907     DOWN2 = 0.
908     DO K=1,5
909     DO M=1,5
910     DOWN2 = DOWN2 + (CHI2D(K)-CHI2DOLD(K))*VECTEMP(K)
911     ENDDO
912     ENDDO
913     IF(DOWN2.EQ.0.) THEN
914     PRINT*,'WARNING IN MATRIX CALULATION (STUDENT), DOWN2 = 0'
915     IFAIL=1
916     RETURN
917     ENDIF
918     c$$$ DO K=1,5 ! BFGS
919     c$$$ U(K) = DAL(K)/DOWN1 - VECTEMP(K)/DOWN2
920     c$$$ ENDDO
921     DO I=1,5
922     DO J=1,5
923     CHI2DD(I,J) = COV(I,J)/2.
924     $ +DAL(I)*DAL(J)/DOWN1
925     $ -VECTEMP(I)*VECTEMP(J)/DOWN2
926     c$$$ $ +DOWN2*U(I)*U(J) ! BFGS
927     ENDDO
928     ENDDO
929     ENDIF
930 mocchiut 1.1
931 pam-fi 1.17 RETURN
932     END
933    
934 mocchiut 1.1 *****************************************************************
935     *
936     * Routine to compute the track intersection points
937     * on the tracking-system planes, given the track parameters
938     *
939     * The routine is based on GRKUTA, which computes the
940     * trajectory of a charged particle in a magnetic field
941     * by solving the equatins of motion with Runge-Kuta method.
942     *
943     * Variables that have to be assigned when the subroutine
944     * is called are:
945     *
946     * ZM(1,NPLANES) ----> z coordinates of the planes
947     * AL_P(1,5) ----> track-parameter vector
948     *
949     * -----------------------------------------------------------
950     * NB !!!
951     * The routine works properly only if the
952     * planes are numbered in descending order starting from the
953     * reference plane (ZINI)
954     * -----------------------------------------------------------
955     *
956     *****************************************************************
957    
958     SUBROUTINE POSXYZ(AL_P,IFAIL)
959    
960     IMPLICIT DOUBLE PRECISION (A-H,O-Z)
961    
962     include 'commontracker.f' !tracker general common
963     include 'common_mini_2.f' !common for the tracking procedure
964 pam-fi 1.3
965 pam-fi 1.4 c LOGICAL TRKVERBOSE
966     c COMMON/TRKD/TRKVERBOSE
967     LOGICAL TRKDEBUG,TRKVERBOSE
968     COMMON/TRKD/TRKDEBUG,TRKVERBOSE
969 mocchiut 1.1 c
970     DIMENSION AL_P(5)
971     *
972 pam-fi 1.14 cpp DO I=1,nplanes
973     cpp ZV(I)=ZM(I) !
974     cpp ENDDO
975 mocchiut 1.1 *
976     * set parameters for GRKUTA
977     *
978     IF(AL_P(5).NE.0) CHARGE=AL_P(5)/DABS(AL_P(5))
979     IF(AL_P(5).EQ.0) CHARGE=1.
980     VOUT(1)=AL_P(1)
981     VOUT(2)=AL_P(2)
982     VOUT(3)=ZINI ! DBLE(Z0)-DBLE(ZSPEC)
983     VOUT(4)=AL_P(3)*DCOS(AL_P(4))
984     VOUT(5)=AL_P(3)*DSIN(AL_P(4))
985     VOUT(6)=-1.*DSQRT(1.-AL_P(3)**2)
986     IF(AL_P(5).NE.0.) VOUT(7)=DABS(1./AL_P(5))
987     IF(AL_P(5).EQ.0.) VOUT(7)=1.E8
988 pam-fi 1.5
989 pam-fi 1.10 c$$$ print*,'POSXY (prima) ',vout
990 pam-fi 1.5
991 mocchiut 1.1 DO I=1,nplanes
992 pam-fi 1.14 cpp step=vout(3)-zv(i)
993     step=vout(3)-zm(i)
994 mocchiut 1.1 10 DO J=1,7
995     VECT(J)=VOUT(J)
996     VECTINI(J)=VOUT(J)
997     ENDDO
998     11 continue
999     CALL GRKUTA(CHARGE,STEP,VECT,VOUT)
1000     IF(VOUT(3).GT.VECT(3)) THEN
1001     IFAIL=1
1002 pam-fi 1.4 if(TRKVERBOSE)
1003 pam-fi 1.2 $ PRINT *,'posxy (grkuta): WARNING ===> backward track!!'
1004 pam-fi 1.4 c$$$ if(.TRUE.)print*,'charge',charge
1005     c$$$ if(.TRUE.)print*,'vect',vect
1006     c$$$ if(.TRUE.)print*,'vout',vout
1007     c$$$ if(.TRUE.)print*,'step',step
1008     if(TRKVERBOSE)print*,'charge',charge
1009     if(TRKVERBOSE)print*,'vect',vect
1010     if(TRKVERBOSE)print*,'vout',vout
1011     if(TRKVERBOSE)print*,'step',step
1012 mocchiut 1.1 RETURN
1013     ENDIF
1014     Z=VOUT(3)
1015     IF(Z.LE.ZM(I)+TOLL.AND.Z.GE.ZM(I)-TOLL) GOTO 100
1016     IF(Z.GT.ZM(I)+TOLL) GOTO 10
1017     IF(Z.LE.ZM(I)-TOLL) THEN
1018     STEP=STEP*(ZM(I)-VECT(3))/(Z-VECT(3))
1019     DO J=1,7
1020     VECT(J)=VECTINI(J)
1021     ENDDO
1022     GOTO 11
1023     ENDIF
1024    
1025 pam-fi 1.10
1026 mocchiut 1.1 * -----------------------------------------------
1027     * evaluate track coordinates
1028     100 XV(I)=VOUT(1)
1029     YV(I)=VOUT(2)
1030     ZV(I)=VOUT(3)
1031     AXV(I)=DATAN(VOUT(4)/VOUT(6))*180./ACOS(-1.)
1032     AYV(I)=DATAN(VOUT(5)/VOUT(6))*180./ACOS(-1.)
1033     * -----------------------------------------------
1034    
1035 pam-fi 1.13 IF(TRACKMODE.EQ.1) THEN
1036     * -----------------------------------------------
1037     * change of energy by bremsstrahlung for electrons
1038     VOUT(7) = VOUT(7) * 0.997 !0.9968
1039     * -----------------------------------------------
1040     ENDIF
1041    
1042 mocchiut 1.1 ENDDO
1043    
1044 pam-fi 1.10 c$$$ print*,'POSXY (dopo) ',vout
1045    
1046    
1047 mocchiut 1.1 RETURN
1048     END
1049    
1050    
1051    
1052    
1053    
1054     * **********************************************************
1055     * Some initialization routines
1056     * **********************************************************
1057    
1058     * ----------------------------------------------------------
1059     * Routine to initialize COMMON/TRACK/
1060     *
1061     subroutine track_init
1062    
1063     IMPLICIT DOUBLE PRECISION (A-H,O-Z)
1064    
1065     include 'commontracker.f' !tracker general common
1066     include 'common_mini_2.f' !common for the tracking procedure
1067     include 'common_mech.f'
1068    
1069     do i=1,5
1070     AL(i) = 0.
1071     enddo
1072    
1073     do ip=1,NPLANES
1074     ZM(IP) = fitz(nplanes-ip+1) !init to mech. position
1075     XM(IP) = -100. !0.
1076     YM(IP) = -100. !0.
1077     XM_A(IP) = -100. !0.
1078     YM_A(IP) = -100. !0.
1079     c ZM_A(IP) = 0
1080     XM_B(IP) = -100. !0.
1081     YM_B(IP) = -100. !0.
1082     c ZM_B(IP) = 0
1083     RESX(IP) = 1000. !3.d-4
1084     RESY(IP) = 1000. !12.d-4
1085     XGOOD(IP) = 0
1086     YGOOD(IP) = 0
1087 pam-fi 1.15 DEDXTRK_X(IP) = 0
1088     DEDXTRK_Y(IP) = 0
1089     AXV(IP) = 0
1090     AYV(IP) = 0
1091     XV(IP) = -100
1092     YV(IP) = -100
1093 mocchiut 1.1 enddo
1094    
1095     return
1096     end
1097 pam-fi 1.4
1098    
1099     ***************************************************
1100     * *
1101     * *
1102     * *
1103     * *
1104     * *
1105     * *
1106     **************************************************
1107    
1108     subroutine guess()
1109    
1110     c IMPLICIT DOUBLE PRECISION (A-H,O-Z)
1111    
1112     include 'commontracker.f' !tracker general common
1113     include 'common_mini_2.f' !common for the tracking procedure
1114    
1115     REAL*4 XP(NPLANES),ZP(NPLANES),AP(NPLANES),RP(NPLANES)
1116     REAL*4 CHI,XC,ZC,RADIUS
1117     * ----------------------------------------
1118     * Y view
1119     * ----------------------------------------
1120     * ----------------------------------------
1121     * initial guess with a straigth line
1122     * ----------------------------------------
1123     SZZ=0.
1124     SZY=0.
1125     SSY=0.
1126     SZ=0.
1127     S1=0.
1128     DO I=1,nplanes
1129     IF(YGOOD(I).EQ.1)THEN
1130     YY = YM(I)
1131     IF(XGOOD(I).EQ.0)THEN
1132     YY = (YM_A(I) + YM_B(I))/2
1133     ENDIF
1134     SZZ=SZZ+ZM(I)*ZM(I)
1135     SZY=SZY+ZM(I)*YY
1136     SSY=SSY+YY
1137     SZ=SZ+ZM(I)
1138     S1=S1+1.
1139     ENDIF
1140     ENDDO
1141     DET=SZZ*S1-SZ*SZ
1142     AY=(SZY*S1-SZ*SSY)/DET
1143     BY=(SZZ*SSY-SZY*SZ)/DET
1144     Y0 = AY*ZINI+BY
1145     * ----------------------------------------
1146     * X view
1147     * ----------------------------------------
1148     * ----------------------------------------
1149     * 1) initial guess with a circle
1150     * ----------------------------------------
1151     NP=0
1152     DO I=1,nplanes
1153     IF(XGOOD(I).EQ.1)THEN
1154     XX = XM(I)
1155     IF(YGOOD(I).EQ.0)THEN
1156     XX = (XM_A(I) + XM_B(I))/2
1157     ENDIF
1158     NP=NP+1
1159     XP(NP)=XX
1160     ZP(NP)=ZM(I)
1161     ENDIF
1162     ENDDO
1163 pam-fi 1.9 IFLAG=0 !no debug mode
1164 pam-fi 1.4 CALL TRICIRCLE(NP,XP,ZP,AP,RP,CHI,XC,ZC,RADIUS,IFLAG)
1165 pam-fi 1.14
1166     c$$$ print*,' circle: ',XC,ZC,RADIUS,' --- ',CHI,IFLAG
1167     c$$$ print*,' XP ',(xp(i),i=1,np)
1168     c$$$ print*,' ZP ',(zp(i),i=1,np)
1169     c$$$ print*,' AP ',(ap(i),i=1,np)
1170     c$$$ print*,' XP ',(rp(i),i=1,np)
1171    
1172 pam-fi 1.4 IF(IFLAG.NE.0)GOTO 10 !straigth fit
1173 pam-fi 1.14 c if(CHI.gt.100)GOTO 10 !straigth fit
1174 pam-fi 1.4 ARG = RADIUS**2-(ZINI-ZC)**2
1175     IF(ARG.LT.0)GOTO 10 !straigth fit
1176     DC = SQRT(ARG)
1177     IF(XC.GT.0)DC=-DC
1178     X0=XC+DC
1179     AX = -(ZINI-ZC)/DC
1180     DEF=100./(RADIUS*0.3*0.43)
1181     IF(XC.GT.0)DEF=-DEF
1182 pam-fi 1.8
1183 pam-fi 1.14
1184    
1185 pam-fi 1.8 IF(ABS(X0).GT.30)THEN
1186 pam-fi 1.10 c$$$ PRINT*,'STRANGE GUESS: XC,ZC,R ',XC,ZC,RADIUS
1187     c$$$ $ ,' - CHI ',CHI,' - X0,AX,DEF ',X0,AX,DEF
1188 pam-fi 1.8 GOTO 10 !straigth fit
1189     ENDIF
1190 pam-fi 1.4 GOTO 20 !guess is ok
1191    
1192     * ----------------------------------------
1193     * 2) initial guess with a straigth line
1194     * - if circle does not intersect reference plane
1195     * - if bad chi**2
1196     * ----------------------------------------
1197     10 CONTINUE
1198     SZZ=0.
1199     SZX=0.
1200     SSX=0.
1201     SZ=0.
1202     S1=0.
1203     DO I=1,nplanes
1204     IF(XGOOD(I).EQ.1)THEN
1205     XX = XM(I)
1206     IF(YGOOD(I).EQ.0)THEN
1207     XX = (XM_A(I) + XM_B(I))/2
1208     ENDIF
1209     SZZ=SZZ+ZM(I)*ZM(I)
1210     SZX=SZX+ZM(I)*XX
1211     SSX=SSX+XX
1212     SZ=SZ+ZM(I)
1213     S1=S1+1.
1214     ENDIF
1215     ENDDO
1216     DET=SZZ*S1-SZ*SZ
1217     AX=(SZX*S1-SZ*SSX)/DET
1218     BX=(SZZ*SSX-SZX*SZ)/DET
1219     DEF = 0
1220     X0 = AX*ZINI+BX
1221    
1222     20 CONTINUE
1223     * ----------------------------------------
1224     * guess
1225     * ----------------------------------------
1226    
1227     AL(1) = X0
1228     AL(2) = Y0
1229     tath = sqrt(AY**2+AX**2)
1230     AL(3) = tath/sqrt(1+tath**2)
1231 pam-fi 1.10 c$$$ IF(AX.NE.0)THEN
1232     c$$$ AL(4)= atan(AY/AX)
1233     c$$$ ELSE
1234     c$$$ AL(4) = acos(-1.)/2
1235     c$$$ IF(AY.LT.0)AL(4) = AL(4)+acos(-1.)
1236     c$$$ ENDIF
1237     c$$$ IF(AX.LT.0)AL(4)= acos(-1.)+ AL(4)
1238     c$$$ AL(4) = -acos(-1.) + AL(4) !from incidence direction to tracking ref.sys.
1239    
1240     c$$$ AL(4) = 0.
1241     c$$$ IF(AX.NE.0.AND.AY.NE.0)THEN
1242     c$$$ AL(4)= atan(AY/AX)
1243     c$$$ ELSEIF(AY.EQ.0)THEN
1244     c$$$ AL(4) = 0.
1245     c$$$ IF(AX.LT.0)AL(4) = AL(4)+acos(-1.)
1246     c$$$ ELSEIF(AX.EQ.0)THEN
1247     c$$$ AL(4) = acos(-1.)/2
1248     c$$$ IF(AY.LT.0)AL(4) = AL(4)+acos(-1.)
1249     c$$$ ENDIF
1250     c$$$ IF(AX.LT.0)AL(4)= acos(-1.)+ AL(4)
1251     c$$$ AL(4) = -acos(-1.) + AL(4) !from incidence direction to tracking ref.sys.
1252    
1253     c$$$ AL(4)=0.
1254     c$$$ IF( AX.NE.0.OR.AY.NE.0. ) THEN
1255     c$$$ AL(4) = ASIN(AY/SQRT(AX**2+AY**2))
1256     c$$$ IF(AX.LT.0.) AL(4) = ACOS(-1.0)-AL(4)
1257     c$$$ ENDIF
1258    
1259     AL(4)=0.
1260     IF( AX.NE.0.OR.AY.NE.0. ) THEN
1261     AL(4) = ASIN(AY/SQRT(AX**2+AY**2))
1262     IF(AX.LT.0.AND.AY.GE.0) AL(4) = ACOS(-1.0)-AL(4)
1263     IF(AX.LT.0.AND.AY.LT.0) AL(4) = -ACOS(-1.0)-AL(4)
1264 pam-fi 1.4 ENDIF
1265 pam-fi 1.10 IF(AY.GT.0.) AL(4) = AL(4)-ACOS(-1.0)
1266     IF(AY.LE.0.) AL(4) = AL(4)+ACOS(-1.0)
1267    
1268 pam-fi 1.4 AL(5) = DEF
1269    
1270     c print*,' guess: ',(al(i),i=1,5)
1271    
1272     end

  ViewVC Help
Powered by ViewVC 1.1.23