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

  ViewVC Help
Powered by ViewVC 1.1.23