/[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.17 - (hide annotations) (download)
Thu May 24 13:29:09 2007 UTC (17 years, 6 months ago) by pam-fi
Branch: MAIN
Changes since 1.16: +451 -132 lines
Student Fit

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

  ViewVC Help
Powered by ViewVC 1.1.23